From 3e29c664ac39d1cd75420fb244daf9b2e05b98ca Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Wed, 27 Sep 2023 11:41:02 +0300
Subject: [PATCH 01/69] core: remote host/controller types (#3104)

* Start sprinkling ZoneId everywhere

* Draft zone/satellite/host api

* Add zone dispatching

* Add command relaying handler

* Parse commands and begin DB

* Implement discussed things

* Resolve some comments

* Resolve more stuff

* Make bots ignore remoteHostId from queues

* Fix tests and stub more

* Untangle cmd relaying

* Resolve comments

* Add more http2 client funs

* refactor, rename

* rename

* remove empty tests

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 apps/simplex-bot-advanced/Main.hs             |  2 +-
 .../src/Broadcast/Bot.hs                      |  2 +-
 apps/simplex-chat/Server.hs                   |  2 +-
 .../src/Directory/Service.hs                  |  8 +-
 package.yaml                                  |  2 +
 simplex-chat.cabal                            | 18 ++++
 src/Simplex/Chat.hs                           | 62 +++++++++++--
 src/Simplex/Chat/Bot.hs                       |  2 +-
 src/Simplex/Chat/Controller.hs                | 91 +++++++++++++++++-
 src/Simplex/Chat/Core.hs                      |  2 +-
 .../Migrations/M20230922_remote_controller.hs | 31 +++++++
 src/Simplex/Chat/Migrations/chat_schema.sql   | 14 +++
 src/Simplex/Chat/Mobile.hs                    | 23 ++++-
 src/Simplex/Chat/Remote.hs                    | 92 +++++++++++++++++++
 src/Simplex/Chat/Remote/Types.hs              | 46 ++++++++++
 src/Simplex/Chat/Store/Migrations.hs          |  4 +-
 src/Simplex/Chat/Store/Remote.hs              | 28 ++++++
 src/Simplex/Chat/Terminal/Input.hs            |  2 +-
 src/Simplex/Chat/Terminal/Output.hs           |  2 +-
 src/Simplex/Chat/Types.hs                     |  2 +-
 src/Simplex/Chat/View.hs                      |  3 +
 21 files changed, 413 insertions(+), 25 deletions(-)
 create mode 100644 src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
 create mode 100644 src/Simplex/Chat/Remote.hs
 create mode 100644 src/Simplex/Chat/Remote/Types.hs
 create mode 100644 src/Simplex/Chat/Store/Remote.hs

diff --git a/apps/simplex-bot-advanced/Main.hs b/apps/simplex-bot-advanced/Main.hs
index 04d8e4ffa..8d596c970 100644
--- a/apps/simplex-bot-advanced/Main.hs
+++ b/apps/simplex-bot-advanced/Main.hs
@@ -41,7 +41,7 @@ mySquaringBot :: User -> ChatController -> IO ()
 mySquaringBot _user cc = do
   initializeBotAddress cc
   race_ (forever $ void getLine) . forever $ do
-    (_, resp) <- atomically . readTBQueue $ outputQ cc
+    (_, _, resp) <- atomically . readTBQueue $ outputQ cc
     case resp of
       CRContactConnected _ contact _ -> do
         contactConnected contact
diff --git a/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs
index 04b6627f3..afeb116f7 100644
--- a/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs
+++ b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs
@@ -35,7 +35,7 @@ broadcastBot :: BroadcastBotOpts -> User -> ChatController -> IO ()
 broadcastBot BroadcastBotOpts {publishers, welcomeMessage, prohibitedMessage} _user cc = do
   initializeBotAddress cc
   race_ (forever $ void getLine) . forever $ do
-    (_, resp) <- atomically . readTBQueue $ outputQ cc
+    (_, _, resp) <- atomically . readTBQueue $ outputQ cc
     case resp of
       CRContactConnected _ ct _ -> do
         contactConnected ct
diff --git a/apps/simplex-chat/Server.hs b/apps/simplex-chat/Server.hs
index 6f198340f..d32005e57 100644
--- a/apps/simplex-chat/Server.hs
+++ b/apps/simplex-chat/Server.hs
@@ -84,7 +84,7 @@ runChatServer ChatServerConfig {chatPort, clientQSize} cc = do
         >>= processCommand
         >>= atomically . writeTBQueue sndQ
     output ChatClient {sndQ} = forever $ do
-      (_, resp) <- atomically . readTBQueue $ outputQ cc
+      (_, _, resp) <- atomically . readTBQueue $ outputQ cc
       atomically $ writeTBQueue sndQ ChatSrvResponse {corrId = Nothing, resp}
     receive ws ChatClient {rcvQ, sndQ} = forever $ do
       s <- WS.receiveData ws
diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs
index 46abc4652..7ed39847a 100644
--- a/apps/simplex-directory-service/src/Directory/Service.hs
+++ b/apps/simplex-directory-service/src/Directory/Service.hs
@@ -59,7 +59,7 @@ welcomeGetOpts :: IO DirectoryOpts
 welcomeGetOpts = do
   appDir <- getAppUserDataDirectory "simplex"
   opts@DirectoryOpts {coreOptions = CoreChatOpts {dbFilePrefix}, testing} <- getDirectoryOpts appDir "simplex_directory_service"
-  unless testing $ do  
+  unless testing $ do
     putStrLn $ "SimpleX Directory Service Bot v" ++ versionNumber
     putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
   pure opts
@@ -68,7 +68,7 @@ directoryService :: DirectoryStore -> DirectoryOpts -> User -> ChatController ->
 directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User {userId} cc = do
   initializeBotAddress' (not testing) cc
   race_ (forever $ void getLine) . forever $ do
-    (_, resp) <- atomically . readTBQueue $ outputQ cc
+    (_, _, resp) <- atomically . readTBQueue $ outputQ cc
     forM_ (crDirectoryEvent resp) $ \case
       DEContactConnected ct -> deContactConnected ct
       DEGroupInvitation {contact = ct, groupInfo = g, fromMemberRole, memberRole} -> deGroupInvitation ct g fromMemberRole memberRole
@@ -161,7 +161,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User {
     badRolesMsg :: GroupRolesStatus -> Maybe String
     badRolesMsg = \case
       GRSOk -> Nothing
-      GRSServiceNotAdmin -> Just "You must have a group *owner* role to register the group" 
+      GRSServiceNotAdmin -> Just "You must have a group *owner* role to register the group"
       GRSContactNotOwner -> Just "You must grant directory service *admin* role to register the group"
       GRSBadRoles -> Just "You must have a group *owner* role and you must grant directory service *admin* role to register the group"
 
@@ -352,7 +352,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User {
         groupRef = groupReference g
         srvRole = "*" <> B.unpack (strEncode serviceRole) <> "*"
         suSrvRole = "(" <> serviceName <> " role is changed to " <> srvRole <> ")."
-        whenContactIsOwner gr action = 
+        whenContactIsOwner gr action =
           getGroupMember gr >>=
             mapM_ (\cm@GroupMember {memberRole} -> when (memberRole == GROwner && memberActive cm) action)
 
diff --git a/package.yaml b/package.yaml
index 406f9aaba..5c8c11a69 100644
--- a/package.yaml
+++ b/package.yaml
@@ -19,6 +19,7 @@ dependencies:
   - attoparsec == 0.14.*
   - base >= 4.7 && < 5
   - base64-bytestring >= 1.0 && < 1.3
+  - binary >= 0.8 && < 0.9
   - bytestring == 0.11.*
   - composition == 1.0.*
   - constraints >= 0.12 && < 0.14
@@ -30,6 +31,7 @@ dependencies:
   - exceptions == 0.10.*
   - filepath == 1.4.*
   - http-types == 0.12.*
+  - http2
   - memory == 0.18.*
   - mtl == 2.3.*
   - network >= 3.1.2.7 && < 3.2
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 338346b65..eda9c371d 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -113,6 +113,7 @@ library
       Simplex.Chat.Migrations.M20230903_connections_to_subscribe
       Simplex.Chat.Migrations.M20230913_member_contacts
       Simplex.Chat.Migrations.M20230914_member_probes
+      Simplex.Chat.Migrations.M20230922_remote_controller
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared
@@ -120,6 +121,8 @@ library
       Simplex.Chat.Options
       Simplex.Chat.ProfileGenerator
       Simplex.Chat.Protocol
+      Simplex.Chat.Remote
+      Simplex.Chat.Remote.Types
       Simplex.Chat.Store
       Simplex.Chat.Store.Connections
       Simplex.Chat.Store.Direct
@@ -128,6 +131,7 @@ library
       Simplex.Chat.Store.Messages
       Simplex.Chat.Store.Migrations
       Simplex.Chat.Store.Profiles
+      Simplex.Chat.Store.Remote
       Simplex.Chat.Store.Shared
       Simplex.Chat.Styled
       Simplex.Chat.Terminal
@@ -151,6 +155,7 @@ library
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
+    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -162,6 +167,7 @@ library
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
+    , http2
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -199,6 +205,7 @@ executable simplex-bot
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
+    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -210,6 +217,7 @@ executable simplex-bot
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
+    , http2
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -248,6 +256,7 @@ executable simplex-bot-advanced
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
+    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -259,6 +268,7 @@ executable simplex-bot-advanced
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
+    , http2
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -299,6 +309,7 @@ executable simplex-broadcast-bot
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
+    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -310,6 +321,7 @@ executable simplex-broadcast-bot
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
+    , http2
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -349,6 +361,7 @@ executable simplex-chat
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
+    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -360,6 +373,7 @@ executable simplex-chat
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
+    , http2
     , memory ==0.18.*
     , mtl ==2.3.*
     , network ==3.1.*
@@ -403,6 +417,7 @@ executable simplex-directory-service
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
+    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -414,6 +429,7 @@ executable simplex-directory-service
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
+    , http2
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -476,6 +492,7 @@ test-suite simplex-chat-test
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
+    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -489,6 +506,7 @@ test-suite simplex-chat-test
     , filepath ==1.4.*
     , hspec ==2.11.*
     , http-types ==0.12.*
+    , http2
     , memory ==0.18.*
     , mtl ==2.3.*
     , network ==3.1.*
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index e74eaa0f5..d14ab5970 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -62,6 +62,8 @@ import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Options
 import Simplex.Chat.ProfileGenerator (generateRandomProfile)
 import Simplex.Chat.Protocol
+import Simplex.Chat.Remote
+import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store
 import Simplex.Chat.Store.Connections
 import Simplex.Chat.Store.Direct
@@ -204,6 +206,8 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
   sndFiles <- newTVarIO M.empty
   rcvFiles <- newTVarIO M.empty
   currentCalls <- atomically TM.empty
+  remoteHostSessions <- atomically TM.empty
+  remoteCtrlSession <- newTVarIO Nothing
   filesFolder <- newTVarIO optFilesFolder
   chatStoreChanged <- newTVarIO False
   expireCIThreads <- newTVarIO M.empty
@@ -213,7 +217,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
   showLiveItems <- newTVarIO False
   userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
   tempDirectory <- newTVarIO tempDir
-  pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, subscriptionMode, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile}
+  pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, subscriptionMode, chatLock, sndFiles, rcvFiles, currentCalls, remoteHostSessions, remoteCtrlSession, config, sendNotification, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile}
   where
     configServers :: DefaultAgentServers
     configServers =
@@ -340,12 +344,14 @@ stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles,
       mapM_ hClose fs
       atomically $ writeTVar files M.empty
 
-execChatCommand :: ChatMonad' m => ByteString -> m ChatResponse
-execChatCommand s = do
+execChatCommand :: ChatMonad' m => Maybe RemoteHostId -> ByteString -> m ChatResponse
+execChatCommand rh s = do
   u <- readTVarIO =<< asks currentUser
   case parseChatCommand s of
     Left e -> pure $ chatCmdError u e
-    Right cmd -> execChatCommand_ u cmd
+    Right cmd -> case rh of
+      Nothing -> execChatCommand_ u cmd
+      Just remoteHostId -> execRemoteCommand u remoteHostId (s, cmd)
 
 execChatCommand' :: ChatMonad' m => ChatCommand -> m ChatResponse
 execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` cmd)
@@ -353,14 +359,26 @@ execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` c
 execChatCommand_ :: ChatMonad' m => Maybe User -> ChatCommand -> m ChatResponse
 execChatCommand_ u cmd = either (CRChatCmdError u) id <$> runExceptT (processChatCommand cmd)
 
+execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> (ByteString, ChatCommand) -> m ChatResponse
+execRemoteCommand u rh scmd = either (CRChatCmdError u) id <$> runExceptT (withRemoteHostSession rh $ \rhs -> processRemoteCommand rhs scmd)
+
 parseChatCommand :: ByteString -> Either String ChatCommand
 parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace
 
+-- | Emit local events.
 toView :: ChatMonad' m => ChatResponse -> m ()
-toView event = do
-  q <- asks outputQ
-  atomically $ writeTBQueue q (Nothing, event)
+toView = toView_ Nothing
 
+-- | Used by transport to mark remote events with source.
+toViewRemote :: ChatMonad' m => RemoteHostId -> ChatResponse -> m ()
+toViewRemote = toView_ . Just
+
+toView_ :: ChatMonad' m => Maybe RemoteHostId -> ChatResponse -> m ()
+toView_ rh event = do
+  q <- asks outputQ
+  atomically $ writeTBQueue q (Nothing, rh, event)
+
+-- | Chat API commands interpreted in context of a local zone
 processChatCommand :: forall m. ChatMonad m => ChatCommand -> m ChatResponse
 processChatCommand = \case
   ShowActiveUser -> withUser' $ pure . CRActiveUser
@@ -1830,6 +1848,24 @@ processChatCommand = \case
     let pref = uncurry TimedMessagesGroupPreference $ maybe (FEOff, Just 86400) (\ttl -> (FEOn, Just ttl)) ttl_
     updateGroupProfileByName gName $ \p ->
       p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
+  CreateRemoteHost _displayName -> pure $ chatCmdError Nothing "not supported"
+  ListRemoteHosts -> pure $ chatCmdError Nothing "not supported"
+  StartRemoteHost rh -> do
+    RemoteHost {displayName = _, storePath, caKey, caCert} <- error "TODO: get from DB"
+    (fingerprint, sessionCreds) <- error "TODO: derive session creds" (caKey, caCert)
+    _announcer <- async $ error "TODO: run announcer" fingerprint
+    hostAsync <- async $ error "TODO: runServer" storePath sessionCreds
+    chatModifyVar remoteHostSessions $ M.insert rh RemoteHostSession {hostAsync, storePath, ctrlClient = undefined}
+    pure $ chatCmdError Nothing "not supported"
+  StopRemoteHost _rh -> pure $ chatCmdError Nothing "not supported"
+  DisposeRemoteHost _rh -> pure $ chatCmdError Nothing "not supported"
+  RegisterRemoteCtrl _displayName _oobData -> pure $ chatCmdError Nothing "not supported"
+  ListRemoteCtrls -> pure $ chatCmdError Nothing "not supported"
+  StartRemoteCtrl -> pure $ chatCmdError Nothing "not supported"
+  ConfirmRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
+  RejectRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
+  StopRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
+  DisposeRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
   QuitChat -> liftIO exitSuccess
   ShowVersion -> do
     let versionInfo = coreVersionInfo $(simplexmqCommitQ)
@@ -5599,6 +5635,17 @@ chatCommandP =
       "/set disappear @" *> (SetContactTimedMessages <$> displayName <*> optional (A.space *> timedMessagesEnabledP)),
       "/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))),
       ("/incognito" <* optional (A.space *> onOffP)) $> ChatHelp HSIncognito,
+      "/create remote host" *> (CreateRemoteHost <$> textP),
+      "/list remote hosts" $> ListRemoteHosts,
+      "/start remote host " *> (StartRemoteHost <$> A.decimal),
+      "/stop remote host " *> (StopRemoteHost <$> A.decimal),
+      "/dispose remote host " *> (DisposeRemoteHost <$> A.decimal),
+      "/register remote ctrl " *> (RegisterRemoteCtrl <$> textP <*> remoteHostOOBP),
+      "/start remote ctrl" $> StartRemoteCtrl,
+      "/confirm remote ctrl " *> (ConfirmRemoteCtrl <$> A.decimal),
+      "/reject remote ctrl " *> (RejectRemoteCtrl <$> A.decimal),
+      "/stop remote ctrl " *> (StopRemoteCtrl <$> A.decimal),
+      "/dispose remote ctrl " *> (DisposeRemoteCtrl <$> A.decimal),
       ("/quit" <|> "/q" <|> "/exit") $> QuitChat,
       ("/version" <|> "/v") $> ShowVersion,
       "/debug locks" $> DebugLocks,
@@ -5716,6 +5763,7 @@ chatCommandP =
     srvCfgP = strP >>= \case AProtocolType p -> APSC p <$> (A.space *> jsonP)
     toServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True}
     char_ = optional . A.char
+    remoteHostOOBP = RemoteHostOOB <$> textP
 
 adminContactReq :: ConnReqContact
 adminContactReq =
diff --git a/src/Simplex/Chat/Bot.hs b/src/Simplex/Chat/Bot.hs
index ecd1659bc..c5c5ff7ee 100644
--- a/src/Simplex/Chat/Bot.hs
+++ b/src/Simplex/Chat/Bot.hs
@@ -25,7 +25,7 @@ chatBotRepl :: String -> (Contact -> String -> IO String) -> User -> ChatControl
 chatBotRepl welcome answer _user cc = do
   initializeBotAddress cc
   race_ (forever $ void getLine) . forever $ do
-    (_, resp) <- atomically . readTBQueue $ outputQ cc
+    (_, _, resp) <- atomically . readTBQueue $ outputQ cc
     case resp of
       CRContactConnected _ contact _ -> do
         contactConnected contact
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 2c829e4a9..c6405990a 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -46,6 +46,7 @@ import Simplex.Chat.Markdown (MarkdownList)
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Protocol
+import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store (AutoAccept, StoreError, UserContactLink, UserMsgReceiptSettings)
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
@@ -173,7 +174,7 @@ data ChatController = ChatController
     chatStoreChanged :: TVar Bool, -- if True, chat should be fully restarted
     idsDrg :: TVar ChaChaDRG,
     inputQ :: TBQueue String,
-    outputQ :: TBQueue (Maybe CorrId, ChatResponse),
+    outputQ :: TBQueue (Maybe CorrId, Maybe RemoteHostId, ChatResponse),
     notifyQ :: TBQueue Notification,
     sendNotification :: Notification -> IO (),
     subscriptionMode :: TVar SubscriptionMode,
@@ -181,6 +182,8 @@ data ChatController = ChatController
     sndFiles :: TVar (Map Int64 Handle),
     rcvFiles :: TVar (Map Int64 Handle),
     currentCalls :: TMap ContactId Call,
+    remoteHostSessions :: TMap RemoteHostId RemoteHostSession, -- All the active remote hosts
+    remoteCtrlSession :: TVar (Maybe RemoteCtrlSession), -- Supervisor process for hosted controllers
     config :: ChatConfig,
     filesFolder :: TVar (Maybe FilePath), -- path to files folder for mobile apps,
     expireCIThreads :: TMap UserId (Maybe (Async ())),
@@ -410,6 +413,18 @@ data ChatCommand
   | SetUserTimedMessages Bool -- UserId (not used in UI)
   | SetContactTimedMessages ContactName (Maybe TimedMessagesEnabled)
   | SetGroupTimedMessages GroupName (Maybe Int)
+  | CreateRemoteHost Text -- ^ Configure a new remote host
+  | ListRemoteHosts
+  | StartRemoteHost RemoteHostId -- ^ Start and announce a remote host
+  | StopRemoteHost RemoteHostId -- ^ Shut down a running session
+  | DisposeRemoteHost RemoteHostId -- ^ Unregister remote host and remove its data
+  | RegisterRemoteCtrl Text RemoteHostOOB -- ^ Register OOB data for satellite discovery and handshake
+  | StartRemoteCtrl -- ^ Start listening for announcements from all registered controllers
+  | ListRemoteCtrls
+  | ConfirmRemoteCtrl RemoteCtrlId -- ^ Confirm discovered data and store confirmation
+  | RejectRemoteCtrl RemoteCtrlId -- ^ Reject discovered data (and blacklist?)
+  | StopRemoteCtrl RemoteCtrlId -- ^ Stop listening for announcements or terminate an active session
+  | DisposeRemoteCtrl RemoteCtrlId -- ^ Remove all local data associated with a satellite session
   | QuitChat
   | ShowVersion
   | DebugLocks
@@ -580,6 +595,17 @@ data ChatResponse
   | CRNtfMessages {user_ :: Maybe User, connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}
   | CRNewContactConnection {user :: User, connection :: PendingContactConnection}
   | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
+  | CRRemoteHostCreated {remoteHostId :: RemoteHostId, oobData :: RemoteHostOOB}
+  | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]} -- XXX: RemoteHostInfo is mostly concerned with session setup
+  | CRRemoteHostStarted {remoteHostId :: RemoteHostId}
+  | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
+  | CRRemoteHostDisposed {remoteHostId :: RemoteHostId}
+  | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
+  | CRRemoteCtrlRegistered {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlAccepted {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlRejected {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlDisconnected {remoteCtrlId :: RemoteCtrlId}
   | CRSQLResult {rows :: [Text]}
   | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
   | CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks}
@@ -616,10 +642,32 @@ logResponseToFile = \case
   CRMessageError {} -> True
   _ -> False
 
+instance FromJSON ChatResponse where
+  parseJSON todo = pure $ CRCmdOk Nothing -- TODO: actually use the instances
+
 instance ToJSON ChatResponse where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
 
+data RemoteHostOOB = RemoteHostOOB
+  { fingerprint :: Text -- CA key fingerprint
+  }
+  deriving (Show, Generic, ToJSON)
+
+data RemoteHostInfo = RemoteHostInfo
+  { remoteHostId :: RemoteHostId,
+    displayName :: Text,
+    sessionActive :: Bool
+  }
+  deriving (Show, Generic, ToJSON)
+
+data RemoteCtrlInfo = RemoteCtrlInfo
+  { remoteCtrlId :: RemoteCtrlId,
+    displayName :: Text,
+    sessionActive :: Bool
+  }
+  deriving (Show, Generic, ToJSON)
+
 newtype UserPwd = UserPwd {unUserPwd :: Text}
   deriving (Eq, Show)
 
@@ -858,6 +906,8 @@ data ChatError
   | ChatErrorAgent {agentError :: AgentErrorType, connectionEntity_ :: Maybe ConnectionEntity}
   | ChatErrorStore {storeError :: StoreError}
   | ChatErrorDatabase {databaseError :: DatabaseError}
+  | ChatErrorRemoteCtrl {remoteCtrlId :: RemoteCtrlId, remoteControllerError :: RemoteCtrlError}
+  | ChatErrorRemoteHost {remoteHostId :: RemoteHostId, remoteHostError :: RemoteHostError}
   deriving (Show, Exception, Generic)
 
 instance ToJSON ChatError where
@@ -967,6 +1017,41 @@ instance ToJSON SQLiteError where
 throwDBError :: ChatMonad m => DatabaseError -> m ()
 throwDBError = throwError . ChatErrorDatabase
 
+-- TODO review errors, some of it can be covered by HTTP2 errors
+data RemoteHostError
+  = RHMissing -- ^ No remote session matches this identifier
+  | RHBusy -- ^ A session is already running
+  | RHRejected -- ^ A session attempt was rejected by a host
+  | RHTimeout -- ^ A discovery or a remote operation has timed out
+  | RHDisconnected {reason :: Text} -- ^ A session disconnected by a host
+  | RHConnectionLost {reason :: Text} -- ^ A session disconnected due to transport issues
+  deriving (Show, Exception, Generic)
+
+instance FromJSON RemoteHostError where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RH"
+
+instance ToJSON RemoteHostError where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RH"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RH"
+
+-- TODO review errors, some of it can be covered by HTTP2 errors
+data RemoteCtrlError
+  = RCEMissing -- ^ No remote session matches this identifier
+  | RCEBusy -- ^ A session is already running
+  | RCETimeout -- ^ Remote operation timed out
+  | RCEDisconnected {reason :: Text} -- ^ A session disconnected by a controller
+  | RCEConnectionLost {reason :: Text} -- ^ A session disconnected due to transport issues
+  | RCECertificateExpired -- ^ A connection or CA certificate in a chain have bad validity period
+  | RCECertificateUntrusted -- ^ TLS is unable to validate certificate chain presented for a connection
+  deriving (Show, Exception, Generic)
+
+instance FromJSON RemoteCtrlError where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RCE"
+
+instance ToJSON RemoteCtrlError where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RCE"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RCE"
+
 type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m)
 
 type ChatMonad m = (ChatMonad' m, MonadError ChatError m)
@@ -979,6 +1064,10 @@ chatWriteVar :: ChatMonad' m => (ChatController -> TVar a) -> a -> m ()
 chatWriteVar f value = asks f >>= atomically . (`writeTVar` value)
 {-# INLINE chatWriteVar #-}
 
+chatModifyVar :: ChatMonad' m => (ChatController -> TVar a) -> (a -> a) -> m ()
+chatModifyVar f newValue = asks f >>= atomically . (`modifyTVar'` newValue)
+{-# INLINE chatModifyVar #-}
+
 tryChatError :: ChatMonad m => m a -> m (Either ChatError a)
 tryChatError = tryAllErrors mkChatError
 {-# INLINE tryChatError #-}
diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs
index 4af161ab4..5f5a27e77 100644
--- a/src/Simplex/Chat/Core.hs
+++ b/src/Simplex/Chat/Core.hs
@@ -40,7 +40,7 @@ runSimplexChat ChatOpts {maintenance} u cc chat
     waitEither_ a1 a2
 
 sendChatCmdStr :: ChatController -> String -> IO ChatResponse
-sendChatCmdStr cc s = runReaderT (execChatCommand . encodeUtf8 $ T.pack s) cc
+sendChatCmdStr cc s = runReaderT (execChatCommand Nothing . encodeUtf8 $ T.pack s) cc
 
 sendChatCmd :: ChatController -> ChatCommand -> IO ChatResponse
 sendChatCmd cc cmd = runReaderT (execChatCommand' cmd) cc
diff --git a/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs b/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
new file mode 100644
index 000000000..070a4e35c
--- /dev/null
+++ b/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20230922_remote_controller where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20230922_remote_controller :: Query
+m20230922_remote_controller =
+  [sql|
+CREATE TABLE remote_hosts ( -- hosts known to a controlling app
+  remote_host_id INTEGER PRIMARY KEY,
+  display_name TEXT NOT NULL,
+  store_path TEXT NOT NULL,
+  ca_cert BLOB NOT NULL,
+  ca_key BLOB NOT NULL
+);
+
+CREATE TABLE remote_controllers ( -- controllers known to a hosting app
+  remote_controller_id INTEGER PRIMARY KEY,
+  display_name TEXT NOT NULL,
+  fingerprint BLOB NOT NULL
+);
+|]
+
+down_m20230922_remote_controller :: Query
+down_m20230922_remote_controller =
+  [sql|
+DROP TABLE remote_hosts;
+DROP TABLE remote_controllers;
+|]
diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql
index 141247e59..292fcf32f 100644
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -515,6 +515,20 @@ CREATE TABLE IF NOT EXISTS "received_probes"(
   created_at TEXT CHECK(created_at NOT NULL),
   updated_at TEXT CHECK(updated_at NOT NULL)
 );
+CREATE TABLE remote_hosts(
+  -- hosts known to a controlling app
+  remote_host_id INTEGER PRIMARY KEY,
+  display_name TEXT NOT NULL,
+  store_path TEXT NOT NULL,
+  ca_cert BLOB NOT NULL,
+  ca_key BLOB NOT NULL
+);
+CREATE TABLE remote_controllers(
+  -- controllers known to a hosting app
+  remote_controller_id INTEGER PRIMARY KEY,
+  display_name TEXT NOT NULL,
+  fingerprint BLOB NOT NULL
+);
 CREATE INDEX contact_profiles_index ON contact_profiles(
   display_name,
   full_name
diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs
index 700548bb1..664412c58 100644
--- a/src/Simplex/Chat/Mobile.hs
+++ b/src/Simplex/Chat/Mobile.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fobject-code #-}
 
 module Simplex.Chat.Mobile where
 
@@ -37,6 +38,7 @@ import Simplex.Chat.Mobile.File
 import Simplex.Chat.Mobile.Shared
 import Simplex.Chat.Mobile.WebRTC
 import Simplex.Chat.Options
+import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store
 import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Types
@@ -55,6 +57,8 @@ foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString
 
 foreign export ccall "chat_send_cmd" cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
 
+foreign export ccall "chat_send_remote_cmd" cChatSendRemoteCmd :: StablePtr ChatController -> CInt -> CString -> IO CJSONString
+
 foreign export ccall "chat_recv_msg" cChatRecvMsg :: StablePtr ChatController -> IO CJSONString
 
 foreign export ccall "chat_recv_msg_wait" cChatRecvMsgWait :: StablePtr ChatController -> CInt -> IO CJSONString
@@ -102,6 +106,14 @@ cChatSendCmd cPtr cCmd = do
   cmd <- B.packCString cCmd
   newCStringFromLazyBS =<< chatSendCmd c cmd
 
+-- | send command to chat (same syntax as in terminal for now)
+cChatSendRemoteCmd :: StablePtr ChatController -> CInt -> CString -> IO CJSONString
+cChatSendRemoteCmd cPtr cRemoteHostId cCmd = do
+  c <- deRefStablePtr cPtr
+  cmd <- B.packCString cCmd
+  let rhId = Just $ fromIntegral cRemoteHostId
+  newCStringFromLazyBS =<< chatSendRemoteCmd c rhId cmd
+
 -- | receive message from chat (blocking)
 cChatRecvMsg :: StablePtr ChatController -> IO CJSONString
 cChatRecvMsg cc = deRefStablePtr cc >>= chatRecvMsg >>= newCStringFromLazyBS
@@ -195,13 +207,16 @@ chatMigrateInit dbFilePrefix dbKey confirm = runExceptT $ do
           _ -> dbError e
         dbError e = Left . DBMErrorSQL dbFile $ show e
 
-chatSendCmd :: ChatController -> ByteString -> IO JSONByteString
-chatSendCmd cc s = J.encode . APIResponse Nothing <$> runReaderT (execChatCommand s) cc
+chatSendCmd :: ChatController -> B.ByteString -> IO JSONByteString
+chatSendCmd cc = chatSendRemoteCmd cc Nothing
+
+chatSendRemoteCmd :: ChatController -> Maybe RemoteHostId -> B.ByteString -> IO JSONByteString
+chatSendRemoteCmd cc rh s = J.encode . APIResponse Nothing rh <$> runReaderT (execChatCommand rh s) cc
 
 chatRecvMsg :: ChatController -> IO JSONByteString
 chatRecvMsg ChatController {outputQ} = json <$> atomically (readTBQueue outputQ)
   where
-    json (corr, resp) = J.encode APIResponse {corr, resp}
+    json (corr, remoteHostId, resp) = J.encode APIResponse {corr, remoteHostId, resp}
 
 chatRecvMsgWait :: ChatController -> Int -> IO JSONByteString
 chatRecvMsgWait cc time = fromMaybe "" <$> timeout time (chatRecvMsg cc)
@@ -227,7 +242,7 @@ chatPasswordHash pwd salt = either (const "") passwordHash salt'
     salt' = U.decode salt
     passwordHash = U.encode . C.sha512Hash . (pwd <>)
 
-data APIResponse = APIResponse {corr :: Maybe CorrId, resp :: ChatResponse}
+data APIResponse = APIResponse {corr :: Maybe CorrId, remoteHostId :: Maybe RemoteHostId, resp :: ChatResponse}
   deriving (Generic)
 
 instance ToJSON APIResponse where
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
new file mode 100644
index 000000000..ba543e33f
--- /dev/null
+++ b/src/Simplex/Chat/Remote.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Chat.Remote where
+
+import Control.Monad.Except
+import Control.Monad.IO.Class
+import qualified Data.Aeson as J
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.Map.Strict as M
+import qualified Data.Binary.Builder as Binary
+import qualified Network.HTTP.Types as HTTP
+import qualified Network.HTTP2.Client as HTTP2Client
+import Simplex.Chat.Controller
+import Simplex.Chat.Remote.Types
+import Simplex.Chat.Types
+import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
+import qualified Simplex.Messaging.Transport.HTTP2.Client as HTTP2
+import Simplex.Messaging.Util	(bshow)
+import System.Directory (getFileSize)
+
+withRemoteHostSession :: ChatMonad m => RemoteHostId -> (RemoteHostSession -> m a) -> m a
+withRemoteHostSession remoteHostId action = do
+  chatReadVar remoteHostSessions >>= maybe err action . M.lookup remoteHostId
+  where
+    err = throwError $ ChatErrorRemoteHost remoteHostId RHMissing
+
+processRemoteCommand :: ChatMonad m => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
+processRemoteCommand rhs = \case
+  -- XXX: intercept and filter some commands
+  -- TODO: store missing files on remote host
+  (s, _cmd) -> relayCommand rhs s
+
+relayCommand :: ChatMonad m => RemoteHostSession -> ByteString -> m ChatResponse
+relayCommand RemoteHostSession {ctrlClient} s = postBytestring Nothing ctrlClient "/relay" mempty s >>= \case
+  Left e -> error "TODO: http2chatError"
+  Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
+    remoteChatResponse <-
+      if iTax then
+        case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
+          Left e -> error "TODO: json2chatError" e
+          Right (raw :: J.Value) -> case J.fromJSON (sum2tagged raw) of
+            J.Error e -> error "TODO: json2chatError" e
+            J.Success cr -> pure cr
+      else
+        case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
+          Left e -> error "TODO: json2chatError" e
+          Right cr -> pure cr
+    case remoteChatResponse of
+      -- TODO: intercept file responses and fetch files when needed
+      -- XXX: is that even possible, to have a file response to a command?
+      _ -> pure remoteChatResponse
+  where
+    iTax = True -- TODO: get from RemoteHost
+    -- XXX: extract to http2 transport
+    postBytestring timeout c path hs body = liftIO $ HTTP2.sendRequest c req timeout
+      where
+        req = HTTP2Client.requestBuilder "POST" path hs (Binary.fromByteString body)
+
+storeRemoteFile :: ChatMonad m => RemoteHostSession -> FilePath -> m ChatResponse
+storeRemoteFile RemoteHostSession {ctrlClient} localFile = do
+  postFile Nothing ctrlClient "/store" mempty localFile >>= \case
+    Left e -> error "TODO: http2chatError"
+    Right HTTP2.HTTP2Response { response } -> case HTTP.statusCode <$> HTTP2Client.responseStatus response of
+      Just 200 -> pure $ CRCmdOk Nothing
+      unexpected -> error "TODO: http2chatError"
+  where
+    postFile timeout c path hs file = liftIO $ do
+      fileSize <- fromIntegral <$> getFileSize file
+      HTTP2.sendRequest c (req fileSize) timeout
+      where
+        req size = HTTP2Client.requestFile "POST" path hs (HTTP2Client.FileSpec file 0 size)
+
+fetchRemoteFile :: ChatMonad m => RemoteHostSession -> FileTransferId -> m ChatResponse
+fetchRemoteFile RemoteHostSession {ctrlClient, storePath} remoteFileId = do
+  liftIO (HTTP2.sendRequest ctrlClient req Nothing) >>= \case
+    Left e -> error "TODO: http2chatError"
+    Right HTTP2.HTTP2Response {respBody} -> do
+      error "TODO: stream body into a local file" -- XXX: consult headers for a file name?
+  where
+    req = HTTP2Client.requestNoBody "GET" path mempty
+    path = "/fetch/" <> bshow remoteFileId
+
+-- | Convert swift single-field sum encoding into tagged/discriminator-field
+sum2tagged :: J.Value -> J.Value
+sum2tagged = \case
+  J.Object todo'convert -> J.Object todo'convert
+  skip -> skip
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
new file mode 100644
index 000000000..8e705d5d2
--- /dev/null
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Simplex.Chat.Remote.Types where
+
+import Control.Concurrent.Async (Async)
+import Data.ByteString.Char8 (ByteString)
+import Data.Int (Int64)
+import Data.Text (Text)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
+
+type RemoteHostId = Int64
+
+data RemoteHost = RemoteHost
+  { remoteHostId :: RemoteHostId,
+    displayName :: Text,
+    -- | Path to store replicated files
+    storePath :: FilePath,
+    -- | A stable part of X509 credentials used to access the host
+    caCert :: ByteString,
+    -- | Credentials signing key for root and session certs
+    caKey :: C.Key
+  }
+
+type RemoteCtrlId = Int
+
+data RemoteCtrl = RemoteCtrl
+  { remoteCtrlId :: RemoteCtrlId,
+    displayName :: Text,
+    fingerprint :: Text
+  }
+
+data RemoteHostSession = RemoteHostSession
+  { -- | process to communicate with the host
+    hostAsync :: Async (),
+    -- | Path for local resources to be synchronized with host
+    storePath :: FilePath,
+    ctrlClient :: HTTP2Client
+  }
+
+-- | Host-side dual to RemoteHostSession, on-methods represent HTTP API.
+data RemoteCtrlSession = RemoteCtrlSession
+  { -- | process to communicate with the remote controller
+    ctrlAsync :: Async ()
+    -- server :: HTTP2Server
+  }
diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs
index d8bab817e..759244f01 100644
--- a/src/Simplex/Chat/Store/Migrations.hs
+++ b/src/Simplex/Chat/Store/Migrations.hs
@@ -81,6 +81,7 @@ import Simplex.Chat.Migrations.M20230829_connections_chat_vrange
 import Simplex.Chat.Migrations.M20230903_connections_to_subscribe
 import Simplex.Chat.Migrations.M20230913_member_contacts
 import Simplex.Chat.Migrations.M20230914_member_probes
+import Simplex.Chat.Migrations.M20230922_remote_controller
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -161,7 +162,8 @@ schemaMigrations =
     ("20230829_connections_chat_vrange", m20230829_connections_chat_vrange, Just down_m20230829_connections_chat_vrange),
     ("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe),
     ("20230913_member_contacts", m20230913_member_contacts, Just down_m20230913_member_contacts),
-    ("20230914_member_probes", m20230914_member_probes, Just down_m20230914_member_probes)
+    ("20230914_member_probes", m20230914_member_probes, Just down_m20230914_member_probes),
+    ("20230922_remote_controller", m20230922_remote_controller, Just down_m20230922_remote_controller)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs
new file mode 100644
index 000000000..12fcb6c08
--- /dev/null
+++ b/src/Simplex/Chat/Store/Remote.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Chat.Store.Remote where
+
+import Data.ByteString.Char8 (ByteString)
+import Data.Int (Int64)
+import Data.Text (Text)
+import qualified Database.SQLite.Simple as DB
+import Simplex.Chat.Remote.Types (RemoteHostId, RemoteHost (..))
+import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow)
+import qualified Simplex.Messaging.Crypto as C
+
+getRemoteHosts :: DB.Connection -> IO [RemoteHost]
+getRemoteHosts db =
+  map toRemoteHost <$> DB.query_ db remoteHostQuery
+
+getRemoteHost :: DB.Connection -> RemoteHostId -> IO (Maybe RemoteHost)
+getRemoteHost db remoteHostId =
+  maybeFirstRow toRemoteHost $
+    DB.query db (remoteHostQuery <> "WHERE remote_host_id = ?") (DB.Only remoteHostId)
+
+remoteHostQuery :: DB.Query
+remoteHostQuery = "SELECT remote_host_id, display_name, store_path, ca_cert, ca_key FROM remote_hosts"
+
+toRemoteHost :: (Int64, Text, FilePath, ByteString, C.Key) -> RemoteHost
+toRemoteHost (remoteHostId, displayName, storePath, caCert, caKey) =
+  RemoteHost {remoteHostId, displayName, storePath, caCert, caKey}
diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs
index 8841f15ff..1097a7954 100644
--- a/src/Simplex/Chat/Terminal/Input.hs
+++ b/src/Simplex/Chat/Terminal/Input.hs
@@ -56,7 +56,7 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
   let bs = encodeUtf8 $ T.pack s
       cmd = parseChatCommand bs
   unless (isMessage cmd) $ echo s
-  r <- runReaderT (execChatCommand bs) cc
+  r <- runReaderT (execChatCommand Nothing bs) cc
   case r of
     CRChatCmdError _ _ -> when (isMessage cmd) $ echo s
     CRChatError _ _ -> when (isMessage cmd) $ echo s
diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs
index db6f16f3c..74bb9e8c0 100644
--- a/src/Simplex/Chat/Terminal/Output.hs
+++ b/src/Simplex/Chat/Terminal/Output.hs
@@ -112,7 +112,7 @@ withTermLock ChatTerminal {termLock} action = do
 runTerminalOutput :: ChatTerminal -> ChatController -> IO ()
 runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = do
   forever $ do
-    (_, r) <- atomically $ readTBQueue outputQ
+    (_, _, r) <- atomically $ readTBQueue outputQ
     case r of
       CRNewChatItem _ ci -> markChatItemRead ci
       CRChatItemUpdated _ ci -> markChatItemRead ci
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index 93964316c..a228055ad 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -10,13 +10,13 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 5db0c317e..1f110fc95 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -297,6 +297,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
   CRChatError u e -> ttyUser' u $ viewChatError logLevel e
   CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)]
   CRTimedAction _ _ -> []
+  todo'cr -> ["TODO" <> sShow todo'cr]
   where
     ttyUser :: User -> [StyledString] -> [StyledString]
     ttyUser user@User {showNtfs, activeUser} ss
@@ -1677,6 +1678,8 @@ viewChatError logLevel = \case
         Nothing -> ""
       cId :: Connection -> StyledString
       cId conn = sShow conn.connId
+  ChatErrorRemoteCtrl remoteCtrlId todo'rc -> [sShow remoteCtrlId, sShow todo'rc]
+  ChatErrorRemoteHost remoteHostId todo'rh -> [sShow remoteHostId, sShow todo'rh]
   where
     fileNotFound fileId = ["file " <> sShow fileId <> " not found"]
     sqliteError' = \case

From 77410e5d5e434b209297dd4181668b515174723c Mon Sep 17 00:00:00 2001
From: IC Rainbow <aenor.realm@gmail.com>
Date: Wed, 27 Sep 2023 13:40:19 +0300
Subject: [PATCH 02/69] Add remote host discovery

---
 cabal.project                        |   2 +-
 package.yaml                         |   3 +
 simplex-chat.cabal                   |  22 +++++
 src/Simplex/Chat.hs                  |  15 +--
 src/Simplex/Chat/Remote.hs           |   3 +
 src/Simplex/Chat/Remote/Discovery.hs | 132 +++++++++++++++++++++++++++
 src/Simplex/Chat/Remote/Types.hs     |   4 +-
 7 files changed, 171 insertions(+), 10 deletions(-)
 create mode 100644 src/Simplex/Chat/Remote/Discovery.hs

diff --git a/cabal.project b/cabal.project
index b4024f088..7d7339a7f 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: 8d47f690838371bc848e4b31a4b09ef6bf67ccc5
+    tag: 681fa93bf342d7c836fa0ff69b767dcd08526f03
 
 source-repository-package
     type: git
diff --git a/package.yaml b/package.yaml
index 5c8c11a69..5337b7eec 100644
--- a/package.yaml
+++ b/package.yaml
@@ -25,6 +25,7 @@ dependencies:
   - constraints >= 0.12 && < 0.14
   - containers == 0.6.*
   - cryptonite == 0.30.*
+  - data-default >= 0.7 && < 0.8
   - directory == 1.3.*
   - direct-sqlcipher == 2.3.*
   - email-validate == 2.3.*
@@ -35,6 +36,7 @@ dependencies:
   - memory == 0.18.*
   - mtl == 2.3.*
   - network >= 3.1.2.7 && < 3.2
+  - network-udp >= 0.0 && < 0.1
   - optparse-applicative >= 0.15 && < 0.17
   - process == 1.6.*
   - random >= 1.1 && < 1.3
@@ -48,6 +50,7 @@ dependencies:
   - terminal == 0.2.*
   - text == 2.0.*
   - time == 1.9.*
+  - tls
   - unliftio == 0.2.*
   - unliftio-core == 0.2.*
   - zip == 2.0.*
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index eda9c371d..1af77b911 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -122,6 +122,7 @@ library
       Simplex.Chat.ProfileGenerator
       Simplex.Chat.Protocol
       Simplex.Chat.Remote
+      Simplex.Chat.Remote.Discovery
       Simplex.Chat.Remote.Types
       Simplex.Chat.Store
       Simplex.Chat.Store.Connections
@@ -161,6 +162,7 @@ library
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite ==0.30.*
+    , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , email-validate ==2.3.*
@@ -171,6 +173,7 @@ library
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
+    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -184,6 +187,7 @@ library
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
+    , tls
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
@@ -211,6 +215,7 @@ executable simplex-bot
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite ==0.30.*
+    , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , email-validate ==2.3.*
@@ -221,6 +226,7 @@ executable simplex-bot
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
+    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -235,6 +241,7 @@ executable simplex-bot
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
+    , tls
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
@@ -262,6 +269,7 @@ executable simplex-bot-advanced
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite ==0.30.*
+    , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , email-validate ==2.3.*
@@ -272,6 +280,7 @@ executable simplex-bot-advanced
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
+    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -286,6 +295,7 @@ executable simplex-bot-advanced
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
+    , tls
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
@@ -315,6 +325,7 @@ executable simplex-broadcast-bot
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite ==0.30.*
+    , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , email-validate ==2.3.*
@@ -325,6 +336,7 @@ executable simplex-broadcast-bot
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
+    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -339,6 +351,7 @@ executable simplex-broadcast-bot
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
+    , tls
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
@@ -367,6 +380,7 @@ executable simplex-chat
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite ==0.30.*
+    , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , email-validate ==2.3.*
@@ -377,6 +391,7 @@ executable simplex-chat
     , memory ==0.18.*
     , mtl ==2.3.*
     , network ==3.1.*
+    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -391,6 +406,7 @@ executable simplex-chat
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
+    , tls
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
@@ -423,6 +439,7 @@ executable simplex-directory-service
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite ==0.30.*
+    , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , email-validate ==2.3.*
@@ -433,6 +450,7 @@ executable simplex-directory-service
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
+    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -447,6 +465,7 @@ executable simplex-directory-service
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
+    , tls
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
@@ -498,6 +517,7 @@ test-suite simplex-chat-test
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite ==0.30.*
+    , data-default ==0.7.*
     , deepseq ==1.4.*
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
@@ -510,6 +530,7 @@ test-suite simplex-chat-test
     , memory ==0.18.*
     , mtl ==2.3.*
     , network ==3.1.*
+    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -525,6 +546,7 @@ test-suite simplex-chat-test
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
+    , tls
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index d14ab5970..afcd95443 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -63,6 +63,7 @@ import Simplex.Chat.Options
 import Simplex.Chat.ProfileGenerator (generateRandomProfile)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Remote
+import qualified Simplex.Chat.Remote.Discovery as Discovery
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store
 import Simplex.Chat.Store.Connections
@@ -1852,12 +1853,14 @@ processChatCommand = \case
   ListRemoteHosts -> pure $ chatCmdError Nothing "not supported"
   StartRemoteHost rh -> do
     RemoteHost {displayName = _, storePath, caKey, caCert} <- error "TODO: get from DB"
-    (fingerprint, sessionCreds) <- error "TODO: derive session creds" (caKey, caCert)
-    _announcer <- async $ error "TODO: run announcer" fingerprint
-    hostAsync <- async $ error "TODO: runServer" storePath sessionCreds
-    chatModifyVar remoteHostSessions $ M.insert rh RemoteHostSession {hostAsync, storePath, ctrlClient = undefined}
-    pure $ chatCmdError Nothing "not supported"
-  StopRemoteHost _rh -> pure $ chatCmdError Nothing "not supported"
+    (fingerprint :: ByteString, sessionCreds) <- error "TODO: derive session creds" (caKey, caCert)
+    cleanup <- toIO $ chatModifyVar remoteHostSessions (M.delete rh)
+    Discovery.runAnnouncer cleanup fingerprint sessionCreds >>= \case
+      Left todo'err -> pure $ chatCmdError Nothing "TODO: Some HTTP2 error"
+      Right ctrlClient -> do
+        chatModifyVar remoteHostSessions $ M.insert rh RemoteHostSession {storePath, ctrlClient}
+        pure $ CRRemoteHostStarted rh
+  StopRemoteHost rh -> closeRemoteHostSession rh $> CRRemoteHostStopped rh
   DisposeRemoteHost _rh -> pure $ chatCmdError Nothing "not supported"
   RegisterRemoteCtrl _displayName _oobData -> pure $ chatCmdError Nothing "not supported"
   ListRemoteCtrls -> pure $ chatCmdError Nothing "not supported"
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index ba543e33f..34c6b31a4 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -29,6 +29,9 @@ withRemoteHostSession remoteHostId action = do
   where
     err = throwError $ ChatErrorRemoteHost remoteHostId RHMissing
 
+closeRemoteHostSession :: ChatMonad m => RemoteHostId -> m ()
+closeRemoteHostSession rh = withRemoteHostSession rh (liftIO . HTTP2.closeHTTP2Client . ctrlClient)
+
 processRemoteCommand :: ChatMonad m => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
 processRemoteCommand rhs = \case
   -- XXX: intercept and filter some commands
diff --git a/src/Simplex/Chat/Remote/Discovery.hs b/src/Simplex/Chat/Remote/Discovery.hs
new file mode 100644
index 000000000..ace1ced31
--- /dev/null
+++ b/src/Simplex/Chat/Remote/Discovery.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Chat.Remote.Discovery
+  ( runAnnouncer,
+    runDiscoverer,
+  )
+where
+
+import Control.Monad
+import Data.ByteString.Builder (Builder, intDec)
+import Data.Default (def)
+import Data.String (IsString)
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Debug.Trace
+import qualified Network.HTTP.Types as HTTP
+import qualified Network.HTTP2.Server as HTTP2
+import qualified Network.Socket as N
+import qualified Network.TLS as TLS
+import qualified Network.UDP as UDP
+import Simplex.Chat.Controller (ChatMonad)
+import Simplex.Chat.Types ()
+import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Transport (supportedParameters)
+import qualified Simplex.Messaging.Transport as Transport
+import Simplex.Messaging.Transport.Client (TransportHost (..), defaultTransportClientConfig, runTransportClient)
+import Simplex.Messaging.Transport.HTTP2 (defaultHTTP2BufferSize, getHTTP2Body)
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError, attachHTTP2Client, defaultHTTP2ClientConfig)
+import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..), runHTTP2ServerWith)
+import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTransportServer)
+import UnliftIO
+import UnliftIO.Concurrent
+
+runAnnouncer :: (StrEncoding invite, ChatMonad m) => IO () -> invite -> TLS.Credentials -> m (Either HTTP2ClientError HTTP2Client)
+runAnnouncer finished invite credentials = do
+  started <- newEmptyTMVarIO
+  aPid <- async $ announcer started (strEncode invite)
+  let serverParams =
+        def
+          { TLS.serverWantClientCert = False,
+            TLS.serverShared = def {TLS.sharedCredentials = credentials},
+            TLS.serverHooks = def,
+            TLS.serverSupported = supportedParameters
+          }
+  httpClient <- newEmptyMVar
+  liftIO $ runTransportServer started partyPort serverParams defaultTransportServerConfig (run aPid httpClient)
+  takeMVar httpClient
+  where
+    announcer started inviteBS = do
+      atomically (takeTMVar started) >>= \case
+        False ->
+          error "Server not started?.."
+        True -> liftIO $ do
+          traceM $ "TCP server started at " <> partyPort
+          sock <- UDP.clientSocket broadcastAddrV4 partyPort False
+          N.setSocketOption (UDP.udpSocket sock) N.Broadcast 1
+          traceM $ "UDP announce started at " <> broadcastAddrV4 <> ":" <> partyPort
+          traceM $ "Server invite: " <> show inviteBS
+          forever $ do
+            UDP.send sock inviteBS
+            threadDelay 1000000
+
+    run :: Async () -> MVar (Either HTTP2ClientError HTTP2Client) -> Transport.TLS -> IO ()
+    run aPid clientVar tls = do
+      cancel aPid
+      let partyHost = "255.255.255.255" -- XXX: get from tls somehow? not required as host verification is disabled.
+      attachHTTP2Client defaultHTTP2ClientConfig partyHost partyPort finished defaultHTTP2BufferSize tls >>= putMVar clientVar
+
+-- | Link-local broadcast address.
+broadcastAddrV4 :: (IsString a) => a
+broadcastAddrV4 = "255.255.255.255"
+
+partyPort :: (IsString a) => a
+partyPort = "5226" -- XXX: should be `0` or something, to get a random port and announce it
+
+runDiscoverer :: (ChatMonad m) => Text -> m ()
+runDiscoverer oobData =
+  case strDecode (encodeUtf8 oobData) of
+    Left err -> traceM $ "oobData decode error: " <> err
+    Right expected -> liftIO $ do
+      traceM $ "runDiscoverer: locating " <> show oobData
+      sock <- UDP.serverSocket (broadcastAddrV4, read partyPort)
+      N.setSocketOption (UDP.listenSocket sock) N.Broadcast 1
+      traceM $ "runDiscoverer: " <> show sock
+      go sock expected
+  where
+    go sock expected = do
+      (invite, UDP.ClientSockAddr source _cmsg) <- UDP.recvFrom sock
+      traceShowM (invite, source)
+      let expect hash = hash `elem` [expected] -- XXX: can be a callback to fetch actual invite list just in time
+      case strDecode invite of
+        Left err -> do
+          traceM $ "Inivite decode error: " <> err
+          go sock expected
+        Right inviteHash | not (expect inviteHash) -> do
+          traceM $ "Skipping unexpected invite " <> show (strEncode inviteHash)
+          go sock expected
+        Right _expected -> do
+          host <- case source of
+            N.SockAddrInet _port addr -> do
+              pure $ THIPv4 (N.hostAddressToTuple addr)
+            unexpected ->
+              -- TODO: actually, Apple mandates IPv6 support
+              fail $ "Discoverer: expected an IPv4 party, got " <> show unexpected
+          traceM $ "Discoverer: go connect " <> show host
+          runTransportClient defaultTransportClientConfig Nothing host partyPort (Just expected) $ \tls -> do
+            traceM "2PTTH server starting"
+            run tls
+            traceM "2PTTH server finished"
+
+    run tls = runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
+      reqBody <- getHTTP2Body r 16384
+      processRequest HTTP2Request {sessionId, request = r, reqBody, sendResponse}
+
+    processRequest req = do
+      traceM $ "Got request: " <> show (request req)
+      -- TODO: sendResponse req . HTTP2.promiseResponse $ HTTP2.pushPromise path response weight
+      sendResponse req $ HTTP2.responseStreaming HTTP.ok200 sseHeaders sseExample
+
+    sseHeaders = [(HTTP.hContentType, "text/event-stream")]
+
+    sseExample :: (Builder -> IO ()) -> IO () -> IO ()
+    sseExample write flush = forM_ [1 .. 10] $ \i -> do
+      let payload = "[" <> intDec i <> ", \"blah\"]"
+      write "event: message\n" -- XXX: SSE header line
+      write $ "data: " <> payload <> "\n" -- XXX: SSE payload line
+      write "\n" -- XXX: SSE delimiter
+      flush
+      threadDelay 1000000
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index 8e705d5d2..9f28eab55 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -31,9 +31,7 @@ data RemoteCtrl = RemoteCtrl
   }
 
 data RemoteHostSession = RemoteHostSession
-  { -- | process to communicate with the host
-    hostAsync :: Async (),
-    -- | Path for local resources to be synchronized with host
+  { -- | Path for local resources to be synchronized with host
     storePath :: FilePath,
     ctrlClient :: HTTP2Client
   }

From cccb3e33fb2388cc7d76f92e515f4808e51a3bf7 Mon Sep 17 00:00:00 2001
From: IC Rainbow <aenor.realm@gmail.com>
Date: Wed, 27 Sep 2023 18:24:38 +0300
Subject: [PATCH 03/69] Plug discovery into remote controller UI

---
 src/Simplex/Chat.hs                           | 56 ++++++++++--
 src/Simplex/Chat/Controller.hs                | 19 ++--
 .../Migrations/M20230922_remote_controller.hs |  3 +-
 src/Simplex/Chat/Remote.hs                    | 64 +++++++------
 src/Simplex/Chat/Remote/Discovery.hs          | 89 +++++++------------
 src/Simplex/Chat/Remote/Types.hs              | 13 +--
 src/Simplex/Chat/Store/Remote.hs              | 27 +++++-
 src/Simplex/Chat/View.hs                      |  2 +-
 8 files changed, 167 insertions(+), 106 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index afcd95443..849bff97f 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -72,6 +72,7 @@ import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Groups
 import Simplex.Chat.Store.Messages
 import Simplex.Chat.Store.Profiles
+import Simplex.Chat.Store.Remote
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
@@ -1864,11 +1865,56 @@ processChatCommand = \case
   DisposeRemoteHost _rh -> pure $ chatCmdError Nothing "not supported"
   RegisterRemoteCtrl _displayName _oobData -> pure $ chatCmdError Nothing "not supported"
   ListRemoteCtrls -> pure $ chatCmdError Nothing "not supported"
-  StartRemoteCtrl -> pure $ chatCmdError Nothing "not supported"
-  ConfirmRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
-  RejectRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
-  StopRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
-  DisposeRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
+  StartRemoteCtrl ->
+    chatReadVar remoteCtrlSession >>= \case
+      Just _busy -> throwError $ ChatErrorRemoteCtrl RCEBusy
+      Nothing -> do
+        uio <- askUnliftIO
+        accepted <- newEmptyTMVarIO
+        let getControllers = unliftIO uio $ withStore' $ \db ->
+              map (\RemoteCtrl{remoteCtrlId, fingerprint} -> (fingerprint, remoteCtrlId)) <$> getRemoteCtrls (DB.conn db)
+        let started remoteCtrlId = unliftIO uio $ do
+              withStore' (\db -> getRemoteCtrl (DB.conn db) remoteCtrlId) >>= \case
+                Nothing -> pure False
+                Just RemoteCtrl{displayName, accepted=resolution} -> case resolution of
+                  Nothing -> do
+                    -- started/finished wrapper is synchronous, running HTTP server can be delayed here until UI processes the first contact dialogue
+                    toView $ CRRemoteCtrlFirstContact {remoteCtrlId, displayName}
+                    atomically $ takeTMVar accepted
+                  Just known -> atomically $ putTMVar accepted known $> known
+        let finished remoteCtrlId todo'error = unliftIO uio $ do
+              chatWriteVar remoteCtrlSession Nothing
+              toView $ CRRemoteCtrlDisconnected {remoteCtrlId}
+        let process rc req = unliftIO uio $ processControllerCommand rc req
+        ctrlAsync <- async . liftIO $ Discovery.runDiscoverer getControllers started finished process
+        chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {ctrlAsync, accepted}
+        pure CRRemoteCtrlStarted
+  ConfirmRemoteCtrl remoteCtrlId -> do
+    chatReadVar remoteCtrlSession >>= \case
+      Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
+      Just RemoteCtrlSession {accepted} -> do
+        withStore' $ \db -> markRemoteCtrlResolution (DB.conn db) remoteCtrlId True
+        atomically $ putTMVar accepted True
+        pure $ CRRemoteCtrlAccepted {remoteCtrlId}
+  RejectRemoteCtrl remoteCtrlId -> do
+    chatReadVar remoteCtrlSession >>= \case
+      Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
+      Just RemoteCtrlSession {accepted} -> do
+        withStore' $ \db -> markRemoteCtrlResolution (DB.conn db) remoteCtrlId False
+        atomically $ putTMVar accepted False
+        pure $ CRRemoteCtrlRejected {remoteCtrlId}
+  StopRemoteCtrl remoteCtrlId ->
+    chatReadVar remoteCtrlSession >>= \case
+      Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
+      Just RemoteCtrlSession {ctrlAsync} -> do
+        cancel ctrlAsync
+        pure $ CRRemoteCtrlDisconnected {remoteCtrlId}
+  DisposeRemoteCtrl remoteCtrlId ->
+    chatReadVar remoteCtrlSession >>= \case
+      Nothing -> do
+        withStore' $ \db -> deleteRemoteCtrl (DB.conn db) remoteCtrlId
+        pure $ CRRemoteCtrlDisposed {remoteCtrlId}
+      Just _ -> throwError $ ChatErrorRemoteCtrl RCEBusy
   QuitChat -> liftIO exitSuccess
   ShowVersion -> do
     let versionInfo = coreVersionInfo $(simplexmqCommitQ)
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index c6405990a..82a1cbced 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -422,7 +422,7 @@ data ChatCommand
   | StartRemoteCtrl -- ^ Start listening for announcements from all registered controllers
   | ListRemoteCtrls
   | ConfirmRemoteCtrl RemoteCtrlId -- ^ Confirm discovered data and store confirmation
-  | RejectRemoteCtrl RemoteCtrlId -- ^ Reject discovered data (and blacklist?)
+  | RejectRemoteCtrl RemoteCtrlId -- ^ Reject and blacklist discovered data
   | StopRemoteCtrl RemoteCtrlId -- ^ Stop listening for announcements or terminate an active session
   | DisposeRemoteCtrl RemoteCtrlId -- ^ Remove all local data associated with a satellite session
   | QuitChat
@@ -602,9 +602,11 @@ data ChatResponse
   | CRRemoteHostDisposed {remoteHostId :: RemoteHostId}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlRegistered {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlStarted
+  | CRRemoteCtrlFirstContact {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
   | CRRemoteCtrlAccepted {remoteCtrlId :: RemoteCtrlId}
   | CRRemoteCtrlRejected {remoteCtrlId :: RemoteCtrlId}
-  | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
   | CRRemoteCtrlDisconnected {remoteCtrlId :: RemoteCtrlId}
   | CRSQLResult {rows :: [Text]}
   | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
@@ -906,7 +908,7 @@ data ChatError
   | ChatErrorAgent {agentError :: AgentErrorType, connectionEntity_ :: Maybe ConnectionEntity}
   | ChatErrorStore {storeError :: StoreError}
   | ChatErrorDatabase {databaseError :: DatabaseError}
-  | ChatErrorRemoteCtrl {remoteCtrlId :: RemoteCtrlId, remoteControllerError :: RemoteCtrlError}
+  | ChatErrorRemoteCtrl {remoteControllerError :: RemoteCtrlError}
   | ChatErrorRemoteHost {remoteHostId :: RemoteHostId, remoteHostError :: RemoteHostError}
   deriving (Show, Exception, Generic)
 
@@ -1036,13 +1038,14 @@ instance ToJSON RemoteHostError where
 
 -- TODO review errors, some of it can be covered by HTTP2 errors
 data RemoteCtrlError
-  = RCEMissing -- ^ No remote session matches this identifier
+  = RCEMissing {remoteCtrlId :: RemoteCtrlId} -- ^ No remote session matches this identifier
+  | RCEInactive -- ^ No session is running
   | RCEBusy -- ^ A session is already running
   | RCETimeout -- ^ Remote operation timed out
-  | RCEDisconnected {reason :: Text} -- ^ A session disconnected by a controller
-  | RCEConnectionLost {reason :: Text} -- ^ A session disconnected due to transport issues
-  | RCECertificateExpired -- ^ A connection or CA certificate in a chain have bad validity period
-  | RCECertificateUntrusted -- ^ TLS is unable to validate certificate chain presented for a connection
+  | RCEDisconnected {remoteCtrlId :: RemoteCtrlId, reason :: Text} -- ^ A session disconnected by a controller
+  | RCEConnectionLost {remoteCtrlId :: RemoteCtrlId, reason :: Text} -- ^ A session disconnected due to transport issues
+  | RCECertificateExpired {remoteCtrlId :: RemoteCtrlId} -- ^ A connection or CA certificate in a chain have bad validity period
+  | RCECertificateUntrusted {remoteCtrlId :: RemoteCtrlId} -- ^ TLS is unable to validate certificate chain presented for a connection
   deriving (Show, Exception, Generic)
 
 instance FromJSON RemoteCtrlError where
diff --git a/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs b/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
index 070a4e35c..4890bfc22 100644
--- a/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
+++ b/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
@@ -19,7 +19,8 @@ CREATE TABLE remote_hosts ( -- hosts known to a controlling app
 CREATE TABLE remote_controllers ( -- controllers known to a hosting app
   remote_controller_id INTEGER PRIMARY KEY,
   display_name TEXT NOT NULL,
-  fingerprint BLOB NOT NULL
+  fingerprint BLOB NOT NULL,
+  accepted INTEGER
 );
 |]
 
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 34c6b31a4..8e2bedc97 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -10,9 +10,9 @@ module Simplex.Chat.Remote where
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import qualified Data.Aeson as J
+import qualified Data.Binary.Builder as Binary
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.Map.Strict as M
-import qualified Data.Binary.Builder as Binary
 import qualified Network.HTTP.Types as HTTP
 import qualified Network.HTTP2.Client as HTTP2Client
 import Simplex.Chat.Controller
@@ -20,43 +20,44 @@ import Simplex.Chat.Remote.Types
 import Simplex.Chat.Types
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HTTP2
-import Simplex.Messaging.Util	(bshow)
+import qualified Simplex.Messaging.Transport.HTTP2.Server as HTTP2
+import Simplex.Messaging.Util (bshow)
 import System.Directory (getFileSize)
 
-withRemoteHostSession :: ChatMonad m => RemoteHostId -> (RemoteHostSession -> m a) -> m a
+withRemoteHostSession :: (ChatMonad m) => RemoteHostId -> (RemoteHostSession -> m a) -> m a
 withRemoteHostSession remoteHostId action = do
   chatReadVar remoteHostSessions >>= maybe err action . M.lookup remoteHostId
   where
     err = throwError $ ChatErrorRemoteHost remoteHostId RHMissing
 
-closeRemoteHostSession :: ChatMonad m => RemoteHostId -> m ()
+closeRemoteHostSession :: (ChatMonad m) => RemoteHostId -> m ()
 closeRemoteHostSession rh = withRemoteHostSession rh (liftIO . HTTP2.closeHTTP2Client . ctrlClient)
 
-processRemoteCommand :: ChatMonad m => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
+processRemoteCommand :: (ChatMonad m) => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
 processRemoteCommand rhs = \case
   -- XXX: intercept and filter some commands
   -- TODO: store missing files on remote host
   (s, _cmd) -> relayCommand rhs s
 
-relayCommand :: ChatMonad m => RemoteHostSession -> ByteString -> m ChatResponse
-relayCommand RemoteHostSession {ctrlClient} s = postBytestring Nothing ctrlClient "/relay" mempty s >>= \case
-  Left e -> error "TODO: http2chatError"
-  Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
-    remoteChatResponse <-
-      if iTax then
-        case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
-          Left e -> error "TODO: json2chatError" e
-          Right (raw :: J.Value) -> case J.fromJSON (sum2tagged raw) of
-            J.Error e -> error "TODO: json2chatError" e
-            J.Success cr -> pure cr
-      else
-        case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
-          Left e -> error "TODO: json2chatError" e
-          Right cr -> pure cr
-    case remoteChatResponse of
-      -- TODO: intercept file responses and fetch files when needed
-      -- XXX: is that even possible, to have a file response to a command?
-      _ -> pure remoteChatResponse
+relayCommand :: (ChatMonad m) => RemoteHostSession -> ByteString -> m ChatResponse
+relayCommand RemoteHostSession {ctrlClient} s =
+  postBytestring Nothing ctrlClient "/relay" mempty s >>= \case
+    Left e -> error "TODO: http2chatError"
+    Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
+      remoteChatResponse <-
+        if iTax
+          then case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
+            Left e -> error "TODO: json2chatError" e
+            Right (raw :: J.Value) -> case J.fromJSON (sum2tagged raw) of
+              J.Error e -> error "TODO: json2chatError" e
+              J.Success cr -> pure cr
+          else case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
+            Left e -> error "TODO: json2chatError" e
+            Right cr -> pure cr
+      case remoteChatResponse of
+        -- TODO: intercept file responses and fetch files when needed
+        -- XXX: is that even possible, to have a file response to a command?
+        _ -> pure remoteChatResponse
   where
     iTax = True -- TODO: get from RemoteHost
     -- XXX: extract to http2 transport
@@ -64,11 +65,11 @@ relayCommand RemoteHostSession {ctrlClient} s = postBytestring Nothing ctrlClien
       where
         req = HTTP2Client.requestBuilder "POST" path hs (Binary.fromByteString body)
 
-storeRemoteFile :: ChatMonad m => RemoteHostSession -> FilePath -> m ChatResponse
+storeRemoteFile :: (ChatMonad m) => RemoteHostSession -> FilePath -> m ChatResponse
 storeRemoteFile RemoteHostSession {ctrlClient} localFile = do
   postFile Nothing ctrlClient "/store" mempty localFile >>= \case
     Left e -> error "TODO: http2chatError"
-    Right HTTP2.HTTP2Response { response } -> case HTTP.statusCode <$> HTTP2Client.responseStatus response of
+    Right HTTP2.HTTP2Response {response} -> case HTTP.statusCode <$> HTTP2Client.responseStatus response of
       Just 200 -> pure $ CRCmdOk Nothing
       unexpected -> error "TODO: http2chatError"
   where
@@ -78,7 +79,7 @@ storeRemoteFile RemoteHostSession {ctrlClient} localFile = do
       where
         req size = HTTP2Client.requestFile "POST" path hs (HTTP2Client.FileSpec file 0 size)
 
-fetchRemoteFile :: ChatMonad m => RemoteHostSession -> FileTransferId -> m ChatResponse
+fetchRemoteFile :: (ChatMonad m) => RemoteHostSession -> FileTransferId -> m ChatResponse
 fetchRemoteFile RemoteHostSession {ctrlClient, storePath} remoteFileId = do
   liftIO (HTTP2.sendRequest ctrlClient req Nothing) >>= \case
     Left e -> error "TODO: http2chatError"
@@ -93,3 +94,12 @@ sum2tagged :: J.Value -> J.Value
 sum2tagged = \case
   J.Object todo'convert -> J.Object todo'convert
   skip -> skip
+
+-- withRemoteCtrlSession :: (ChatMonad m) => RemoteCtrlId -> (RemoteCtrlSession -> m a) -> m a
+-- withRemoteCtrlSession remoteCtrlId action = do
+--   chatReadVar remoteHostSessions >>= maybe err action . M.lookup remoteCtrlId
+--   where
+--     err = throwError $ ChatErrorRemoteCtrl (Just remoteCtrlId) RCMissing
+
+processControllerCommand :: (ChatMonad m) => RemoteCtrlId -> HTTP2.HTTP2Request -> m ()
+processControllerCommand rc req = error "TODO: processControllerCommand"
diff --git a/src/Simplex/Chat/Remote/Discovery.hs b/src/Simplex/Chat/Remote/Discovery.hs
index ace1ced31..cb668677f 100644
--- a/src/Simplex/Chat/Remote/Discovery.hs
+++ b/src/Simplex/Chat/Remote/Discovery.hs
@@ -10,19 +10,13 @@ module Simplex.Chat.Remote.Discovery
 where
 
 import Control.Monad
-import Data.ByteString.Builder (Builder, intDec)
 import Data.Default (def)
 import Data.String (IsString)
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
 import Debug.Trace
-import qualified Network.HTTP.Types as HTTP
-import qualified Network.HTTP2.Server as HTTP2
 import qualified Network.Socket as N
 import qualified Network.TLS as TLS
 import qualified Network.UDP as UDP
-import Simplex.Chat.Controller (ChatMonad)
-import Simplex.Chat.Types ()
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Transport (supportedParameters)
 import qualified Simplex.Messaging.Transport as Transport
@@ -34,7 +28,7 @@ import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTran
 import UnliftIO
 import UnliftIO.Concurrent
 
-runAnnouncer :: (StrEncoding invite, ChatMonad m) => IO () -> invite -> TLS.Credentials -> m (Either HTTP2ClientError HTTP2Client)
+runAnnouncer :: (StrEncoding invite, MonadUnliftIO m) => IO () -> invite -> TLS.Credentials -> m (Either HTTP2ClientError HTTP2Client)
 runAnnouncer finished invite credentials = do
   started <- newEmptyTMVarIO
   aPid <- async $ announcer started (strEncode invite)
@@ -76,57 +70,38 @@ broadcastAddrV4 = "255.255.255.255"
 partyPort :: (IsString a) => a
 partyPort = "5226" -- XXX: should be `0` or something, to get a random port and announce it
 
-runDiscoverer :: (ChatMonad m) => Text -> m ()
-runDiscoverer oobData =
-  case strDecode (encodeUtf8 oobData) of
-    Left err -> traceM $ "oobData decode error: " <> err
-    Right expected -> liftIO $ do
-      traceM $ "runDiscoverer: locating " <> show oobData
-      sock <- UDP.serverSocket (broadcastAddrV4, read partyPort)
-      N.setSocketOption (UDP.listenSocket sock) N.Broadcast 1
-      traceM $ "runDiscoverer: " <> show sock
-      go sock expected
+runDiscoverer :: IO [(C.KeyHash, ctx)] -> (ctx -> IO Bool) -> (ctx -> Maybe SomeException -> IO ()) -> (ctx -> HTTP2Request -> IO ()) -> IO ()
+runDiscoverer getFingerprints started finished processRequest = do
+  sock <- UDP.serverSocket (broadcastAddrV4, read partyPort)
+  N.setSocketOption (UDP.listenSocket sock) N.Broadcast 1
+  traceM $ "runDiscoverer: " <> show sock
+  go sock
   where
-    go sock expected = do
+    go sock = do
       (invite, UDP.ClientSockAddr source _cmsg) <- UDP.recvFrom sock
-      traceShowM (invite, source)
-      let expect hash = hash `elem` [expected] -- XXX: can be a callback to fetch actual invite list just in time
       case strDecode invite of
         Left err -> do
           traceM $ "Inivite decode error: " <> err
-          go sock expected
-        Right inviteHash | not (expect inviteHash) -> do
-          traceM $ "Skipping unexpected invite " <> show (strEncode inviteHash)
-          go sock expected
-        Right _expected -> do
-          host <- case source of
-            N.SockAddrInet _port addr -> do
-              pure $ THIPv4 (N.hostAddressToTuple addr)
-            unexpected ->
-              -- TODO: actually, Apple mandates IPv6 support
-              fail $ "Discoverer: expected an IPv4 party, got " <> show unexpected
-          traceM $ "Discoverer: go connect " <> show host
-          runTransportClient defaultTransportClientConfig Nothing host partyPort (Just expected) $ \tls -> do
-            traceM "2PTTH server starting"
-            run tls
-            traceM "2PTTH server finished"
-
-    run tls = runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
-      reqBody <- getHTTP2Body r 16384
-      processRequest HTTP2Request {sessionId, request = r, reqBody, sendResponse}
-
-    processRequest req = do
-      traceM $ "Got request: " <> show (request req)
-      -- TODO: sendResponse req . HTTP2.promiseResponse $ HTTP2.pushPromise path response weight
-      sendResponse req $ HTTP2.responseStreaming HTTP.ok200 sseHeaders sseExample
-
-    sseHeaders = [(HTTP.hContentType, "text/event-stream")]
-
-    sseExample :: (Builder -> IO ()) -> IO () -> IO ()
-    sseExample write flush = forM_ [1 .. 10] $ \i -> do
-      let payload = "[" <> intDec i <> ", \"blah\"]"
-      write "event: message\n" -- XXX: SSE header line
-      write $ "data: " <> payload <> "\n" -- XXX: SSE payload line
-      write "\n" -- XXX: SSE delimiter
-      flush
-      threadDelay 1000000
+          go sock
+        Right inviteHash -> do
+          expected <- getFingerprints
+          case lookup inviteHash expected of
+            Nothing -> do
+              traceM $ "Unexpected invite: " <> show (invite, source)
+              go sock
+            Just ctx -> do
+              host <- case source of
+                N.SockAddrInet _port addr -> do
+                  pure $ THIPv4 (N.hostAddressToTuple addr)
+                unexpected ->
+                  -- TODO: actually, Apple mandates IPv6 support
+                  fail $ "Discoverer: expected an IPv4 party, got " <> show unexpected
+              runTransportClient defaultTransportClientConfig Nothing host partyPort (Just inviteHash) $ \tls -> do
+                accepted <- started ctx
+                if not accepted
+                  then go sock -- Ignore rejected invites and wait for another
+                  else do
+                    res <- try $ runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
+                      reqBody <- getHTTP2Body r 16384
+                      processRequest ctx HTTP2Request {sessionId, request = r, reqBody, sendResponse}
+                    finished ctx $ either Just (\() -> Nothing) res
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index 9f28eab55..53f73c338 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -8,6 +8,7 @@ import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
+import UnliftIO.STM
 
 type RemoteHostId = Int64
 
@@ -22,12 +23,13 @@ data RemoteHost = RemoteHost
     caKey :: C.Key
   }
 
-type RemoteCtrlId = Int
+type RemoteCtrlId = Int64
 
 data RemoteCtrl = RemoteCtrl
   { remoteCtrlId :: RemoteCtrlId,
     displayName :: Text,
-    fingerprint :: Text
+    fingerprint :: C.KeyHash,
+    accepted :: Maybe Bool
   }
 
 data RemoteHostSession = RemoteHostSession
@@ -36,9 +38,8 @@ data RemoteHostSession = RemoteHostSession
     ctrlClient :: HTTP2Client
   }
 
--- | Host-side dual to RemoteHostSession, on-methods represent HTTP API.
 data RemoteCtrlSession = RemoteCtrlSession
-  { -- | process to communicate with the remote controller
-    ctrlAsync :: Async ()
-    -- server :: HTTP2Server
+  { -- | Server side of transport to process remote commands and forward notifications
+    ctrlAsync :: Async (),
+    accepted :: TMVar Bool
   }
diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs
index 12fcb6c08..f185000d8 100644
--- a/src/Simplex/Chat/Store/Remote.hs
+++ b/src/Simplex/Chat/Store/Remote.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -7,7 +8,7 @@ import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Database.SQLite.Simple as DB
-import Simplex.Chat.Remote.Types (RemoteHostId, RemoteHost (..))
+import Simplex.Chat.Remote.Types (RemoteCtrl (..), RemoteCtrlId, RemoteHost (..), RemoteHostId)
 import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow)
 import qualified Simplex.Messaging.Crypto as C
 
@@ -26,3 +27,27 @@ remoteHostQuery = "SELECT remote_host_id, display_name, store_path, ca_cert, ca_
 toRemoteHost :: (Int64, Text, FilePath, ByteString, C.Key) -> RemoteHost
 toRemoteHost (remoteHostId, displayName, storePath, caCert, caKey) =
   RemoteHost {remoteHostId, displayName, storePath, caCert, caKey}
+
+getRemoteCtrls :: DB.Connection -> IO [RemoteCtrl]
+getRemoteCtrls db =
+  map toRemoteCtrl <$> DB.query_ db remoteCtrlQuery
+
+getRemoteCtrl :: DB.Connection -> RemoteCtrlId -> IO (Maybe RemoteCtrl)
+getRemoteCtrl db remoteCtrlId =
+  maybeFirstRow toRemoteCtrl $
+    DB.query db (remoteCtrlQuery <> "WHERE remote_controller_id = ?") (DB.Only remoteCtrlId)
+
+remoteCtrlQuery :: DB.Query
+remoteCtrlQuery = "SELECT remote_controller_id, display_name, fingerprint, accepted FROM remote_controllers"
+
+toRemoteCtrl :: (Int64, Text, C.KeyHash, Maybe Bool) -> RemoteCtrl
+toRemoteCtrl (remoteCtrlId, displayName, fingerprint, accepted) =
+  RemoteCtrl {remoteCtrlId, displayName, fingerprint, accepted}
+
+markRemoteCtrlResolution :: DB.Connection -> RemoteCtrlId -> Bool -> IO ()
+markRemoteCtrlResolution db remoteCtrlId accepted =
+  DB.execute db "UPDATE remote_controllers SET accepted = ? WHERE remote_controller_id = ?" (accepted, remoteCtrlId)
+
+deleteRemoteCtrl :: DB.Connection -> RemoteCtrlId -> IO ()
+deleteRemoteCtrl db remoteCtrlId =
+  DB.execute db "DELETE FROM remote_controllers WHERE remote_controller_id = ?" (DB.Only remoteCtrlId)
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 1f110fc95..1761b384a 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -1678,7 +1678,7 @@ viewChatError logLevel = \case
         Nothing -> ""
       cId :: Connection -> StyledString
       cId conn = sShow conn.connId
-  ChatErrorRemoteCtrl remoteCtrlId todo'rc -> [sShow remoteCtrlId, sShow todo'rc]
+  ChatErrorRemoteCtrl todo'rc -> [sShow todo'rc]
   ChatErrorRemoteHost remoteHostId todo'rh -> [sShow remoteHostId, sShow todo'rh]
   where
     fileNotFound fileId = ["file " <> sShow fileId <> " not found"]

From af2df8d4892216719cf9745cfef1e2834b980c89 Mon Sep 17 00:00:00 2001
From: IC Rainbow <aenor.realm@gmail.com>
Date: Fri, 29 Sep 2023 14:56:56 +0300
Subject: [PATCH 04/69] Rewrite remote controller

---
 src/Simplex/Chat.hs                           | 110 ++---------------
 src/Simplex/Chat/Controller.hs                |  53 +++++++-
 .../Migrations/M20230922_remote_controller.hs |   2 +-
 src/Simplex/Chat/Remote.hs                    | 113 ++++++++++++++++--
 src/Simplex/Chat/Remote/Discovery.hs          |  89 +++++++-------
 src/Simplex/Chat/Remote/Types.hs              |   8 +-
 src/Simplex/Chat/Store/Remote.hs              |   7 +-
 7 files changed, 216 insertions(+), 166 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 849bff97f..ef2f95f67 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -19,7 +19,6 @@ module Simplex.Chat where
 
 import Control.Applicative (optional, (<|>))
 import Control.Concurrent.STM (retry)
-import qualified Control.Exception as E
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
@@ -63,7 +62,6 @@ import Simplex.Chat.Options
 import Simplex.Chat.ProfileGenerator (generateRandomProfile)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Remote
-import qualified Simplex.Chat.Remote.Discovery as Discovery
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store
 import Simplex.Chat.Store.Connections
@@ -72,7 +70,6 @@ import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Groups
 import Simplex.Chat.Store.Messages
 import Simplex.Chat.Store.Profiles
-import Simplex.Chat.Store.Remote
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
@@ -367,19 +364,6 @@ execRemoteCommand u rh scmd = either (CRChatCmdError u) id <$> runExceptT (withR
 parseChatCommand :: ByteString -> Either String ChatCommand
 parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace
 
--- | Emit local events.
-toView :: ChatMonad' m => ChatResponse -> m ()
-toView = toView_ Nothing
-
--- | Used by transport to mark remote events with source.
-toViewRemote :: ChatMonad' m => RemoteHostId -> ChatResponse -> m ()
-toViewRemote = toView_ . Just
-
-toView_ :: ChatMonad' m => Maybe RemoteHostId -> ChatResponse -> m ()
-toView_ rh event = do
-  q <- asks outputQ
-  atomically $ writeTBQueue q (Nothing, rh, event)
-
 -- | Chat API commands interpreted in context of a local zone
 processChatCommand :: forall m. ChatMonad m => ChatCommand -> m ChatResponse
 processChatCommand = \case
@@ -1852,69 +1836,16 @@ processChatCommand = \case
       p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
   CreateRemoteHost _displayName -> pure $ chatCmdError Nothing "not supported"
   ListRemoteHosts -> pure $ chatCmdError Nothing "not supported"
-  StartRemoteHost rh -> do
-    RemoteHost {displayName = _, storePath, caKey, caCert} <- error "TODO: get from DB"
-    (fingerprint :: ByteString, sessionCreds) <- error "TODO: derive session creds" (caKey, caCert)
-    cleanup <- toIO $ chatModifyVar remoteHostSessions (M.delete rh)
-    Discovery.runAnnouncer cleanup fingerprint sessionCreds >>= \case
-      Left todo'err -> pure $ chatCmdError Nothing "TODO: Some HTTP2 error"
-      Right ctrlClient -> do
-        chatModifyVar remoteHostSessions $ M.insert rh RemoteHostSession {storePath, ctrlClient}
-        pure $ CRRemoteHostStarted rh
+  StartRemoteHost rh -> startRemoteHost rh
   StopRemoteHost rh -> closeRemoteHostSession rh $> CRRemoteHostStopped rh
   DisposeRemoteHost _rh -> pure $ chatCmdError Nothing "not supported"
+  StartRemoteCtrl -> startRemoteCtrl
+  ConfirmRemoteCtrl rc -> confirmRemoteCtrl rc
+  RejectRemoteCtrl rc -> rejectRemoteCtrl rc
+  StopRemoteCtrl rc -> stopRemoteCtrl rc
   RegisterRemoteCtrl _displayName _oobData -> pure $ chatCmdError Nothing "not supported"
   ListRemoteCtrls -> pure $ chatCmdError Nothing "not supported"
-  StartRemoteCtrl ->
-    chatReadVar remoteCtrlSession >>= \case
-      Just _busy -> throwError $ ChatErrorRemoteCtrl RCEBusy
-      Nothing -> do
-        uio <- askUnliftIO
-        accepted <- newEmptyTMVarIO
-        let getControllers = unliftIO uio $ withStore' $ \db ->
-              map (\RemoteCtrl{remoteCtrlId, fingerprint} -> (fingerprint, remoteCtrlId)) <$> getRemoteCtrls (DB.conn db)
-        let started remoteCtrlId = unliftIO uio $ do
-              withStore' (\db -> getRemoteCtrl (DB.conn db) remoteCtrlId) >>= \case
-                Nothing -> pure False
-                Just RemoteCtrl{displayName, accepted=resolution} -> case resolution of
-                  Nothing -> do
-                    -- started/finished wrapper is synchronous, running HTTP server can be delayed here until UI processes the first contact dialogue
-                    toView $ CRRemoteCtrlFirstContact {remoteCtrlId, displayName}
-                    atomically $ takeTMVar accepted
-                  Just known -> atomically $ putTMVar accepted known $> known
-        let finished remoteCtrlId todo'error = unliftIO uio $ do
-              chatWriteVar remoteCtrlSession Nothing
-              toView $ CRRemoteCtrlDisconnected {remoteCtrlId}
-        let process rc req = unliftIO uio $ processControllerCommand rc req
-        ctrlAsync <- async . liftIO $ Discovery.runDiscoverer getControllers started finished process
-        chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {ctrlAsync, accepted}
-        pure CRRemoteCtrlStarted
-  ConfirmRemoteCtrl remoteCtrlId -> do
-    chatReadVar remoteCtrlSession >>= \case
-      Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
-      Just RemoteCtrlSession {accepted} -> do
-        withStore' $ \db -> markRemoteCtrlResolution (DB.conn db) remoteCtrlId True
-        atomically $ putTMVar accepted True
-        pure $ CRRemoteCtrlAccepted {remoteCtrlId}
-  RejectRemoteCtrl remoteCtrlId -> do
-    chatReadVar remoteCtrlSession >>= \case
-      Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
-      Just RemoteCtrlSession {accepted} -> do
-        withStore' $ \db -> markRemoteCtrlResolution (DB.conn db) remoteCtrlId False
-        atomically $ putTMVar accepted False
-        pure $ CRRemoteCtrlRejected {remoteCtrlId}
-  StopRemoteCtrl remoteCtrlId ->
-    chatReadVar remoteCtrlSession >>= \case
-      Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
-      Just RemoteCtrlSession {ctrlAsync} -> do
-        cancel ctrlAsync
-        pure $ CRRemoteCtrlDisconnected {remoteCtrlId}
-  DisposeRemoteCtrl remoteCtrlId ->
-    chatReadVar remoteCtrlSession >>= \case
-      Nothing -> do
-        withStore' $ \db -> deleteRemoteCtrl (DB.conn db) remoteCtrlId
-        pure $ CRRemoteCtrlDisposed {remoteCtrlId}
-      Just _ -> throwError $ ChatErrorRemoteCtrl RCEBusy
+  DisposeRemoteCtrl rc -> disposeRemoteCtrl rc
   QuitChat -> liftIO exitSuccess
   ShowVersion -> do
     let versionInfo = coreVersionInfo $(simplexmqCommitQ)
@@ -5410,33 +5341,6 @@ withAgent action =
     >>= runExceptT . action
     >>= liftEither . first (`ChatErrorAgent` Nothing)
 
-withStore' :: ChatMonad m => (DB.Connection -> IO a) -> m a
-withStore' action = withStore $ liftIO . action
-
-withStore :: ChatMonad m => (DB.Connection -> ExceptT StoreError IO a) -> m a
-withStore = withStoreCtx Nothing
-
-withStoreCtx' :: ChatMonad m => Maybe String -> (DB.Connection -> IO a) -> m a
-withStoreCtx' ctx_ action = withStoreCtx ctx_ $ liftIO . action
-
-withStoreCtx :: ChatMonad m => Maybe String -> (DB.Connection -> ExceptT StoreError IO a) -> m a
-withStoreCtx ctx_ action = do
-  ChatController {chatStore} <- ask
-  liftEitherError ChatErrorStore $ case ctx_ of
-    Nothing -> withTransaction chatStore (runExceptT . action) `E.catch` handleInternal ""
-    -- uncomment to debug store performance
-    -- Just ctx -> do
-    --   t1 <- liftIO getCurrentTime
-    --   putStrLn $ "withStoreCtx start       :: " <> show t1 <> " :: " <> ctx
-    --   r <- withTransactionCtx ctx_ chatStore (runExceptT . action) `E.catch` handleInternal (" (" <> ctx <> ")")
-    --   t2 <- liftIO getCurrentTime
-    --   putStrLn $ "withStoreCtx end         :: " <> show t2 <> " :: " <> ctx <> " :: duration=" <> show (diffToMilliseconds $ diffUTCTime t2 t1)
-    --   pure r
-    Just _ -> withTransaction chatStore (runExceptT . action) `E.catch` handleInternal ""
-  where
-    handleInternal :: String -> E.SomeException -> IO (Either StoreError a)
-    handleInternal ctxStr e = pure . Left . SEInternalError $ show e <> ctxStr
-
 chatCommandP :: Parser ChatCommand
 chatCommandP =
   choice
@@ -5689,8 +5593,8 @@ chatCommandP =
       "/start remote host " *> (StartRemoteHost <$> A.decimal),
       "/stop remote host " *> (StopRemoteHost <$> A.decimal),
       "/dispose remote host " *> (DisposeRemoteHost <$> A.decimal),
-      "/register remote ctrl " *> (RegisterRemoteCtrl <$> textP <*> remoteHostOOBP),
       "/start remote ctrl" $> StartRemoteCtrl,
+      "/register remote ctrl " *> (RegisterRemoteCtrl <$> textP <*> remoteHostOOBP),
       "/confirm remote ctrl " *> (ConfirmRemoteCtrl <$> A.decimal),
       "/reject remote ctrl " *> (RejectRemoteCtrl <$> A.decimal),
       "/stop remote ctrl " *> (StopRemoteCtrl <$> A.decimal),
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 82a1cbced..0598bba8f 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -47,7 +47,7 @@ import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.Types
-import Simplex.Chat.Store (AutoAccept, StoreError, UserContactLink, UserMsgReceiptSettings)
+import Simplex.Chat.Store (AutoAccept, StoreError (..), UserContactLink, UserMsgReceiptSettings)
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent (AgentClient, SubscriptionsInfo)
@@ -57,6 +57,8 @@ import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, UpMigration)
 import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
+import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction)
+import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import qualified Simplex.Messaging.Crypto.File as CF
@@ -67,7 +69,7 @@ import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType, CorrId,
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Util (allFinally, catchAllErrors, tryAllErrors, (<$$>))
+import Simplex.Messaging.Util (allFinally, catchAllErrors, liftEitherError, tryAllErrors, (<$$>))
 import Simplex.Messaging.Version
 import System.IO (Handle)
 import System.Mem.Weak (Weak)
@@ -603,11 +605,14 @@ data ChatResponse
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlRegistered {remoteCtrlId :: RemoteCtrlId}
   | CRRemoteCtrlStarted
-  | CRRemoteCtrlFirstContact {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
+  | CRRemoteCtrlAnnounce {fingerprint :: C.KeyHash} -- unregistered fingerprint, needs confirmation
+  | CRRemoteCtrlFound {remoteCtrl::RemoteCtrl} -- registered fingerprint, may connect
+  -- | CRRemoteCtrlFirstContact {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
   | CRRemoteCtrlAccepted {remoteCtrlId :: RemoteCtrlId}
   | CRRemoteCtrlRejected {remoteCtrlId :: RemoteCtrlId}
   | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
-  | CRRemoteCtrlDisconnected {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlStopped {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlDisposed {remoteCtrlId :: RemoteCtrlId}
   | CRSQLResult {rows :: [Text]}
   | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
   | CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks}
@@ -1106,3 +1111,43 @@ data ArchiveError
 instance ToJSON ArchiveError where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "AE"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "AE"
+
+-- | Emit local events.
+toView :: ChatMonad' m => ChatResponse -> m ()
+toView = toView_ Nothing
+
+-- | Used by transport to mark remote events with source.
+toViewRemote :: ChatMonad' m => RemoteHostId -> ChatResponse -> m ()
+toViewRemote = toView_ . Just
+
+toView_ :: ChatMonad' m => Maybe RemoteHostId -> ChatResponse -> m ()
+toView_ rh event = do
+  q <- asks outputQ
+  atomically $ writeTBQueue q (Nothing, rh, event)
+
+withStore' :: ChatMonad m => (DB.Connection -> IO a) -> m a
+withStore' action = withStore $ liftIO . action
+
+withStore :: ChatMonad m => (DB.Connection -> ExceptT StoreError IO a) -> m a
+withStore = withStoreCtx Nothing
+
+withStoreCtx' :: ChatMonad m => Maybe String -> (DB.Connection -> IO a) -> m a
+withStoreCtx' ctx_ action = withStoreCtx ctx_ $ liftIO . action
+
+withStoreCtx :: ChatMonad m => Maybe String -> (DB.Connection -> ExceptT StoreError IO a) -> m a
+withStoreCtx ctx_ action = do
+  ChatController {chatStore} <- ask
+  liftEitherError ChatErrorStore $ case ctx_ of
+    Nothing -> withTransaction chatStore (runExceptT . action) `catch` handleInternal ""
+    -- uncomment to debug store performance
+    -- Just ctx -> do
+    --   t1 <- liftIO getCurrentTime
+    --   putStrLn $ "withStoreCtx start       :: " <> show t1 <> " :: " <> ctx
+    --   r <- withTransactionCtx ctx_ chatStore (runExceptT . action) `E.catch` handleInternal (" (" <> ctx <> ")")
+    --   t2 <- liftIO getCurrentTime
+    --   putStrLn $ "withStoreCtx end         :: " <> show t2 <> " :: " <> ctx <> " :: duration=" <> show (diffToMilliseconds $ diffUTCTime t2 t1)
+    --   pure r
+    Just _ -> withTransaction chatStore (runExceptT . action) `catch` handleInternal ""
+  where
+    handleInternal :: String -> SomeException -> IO (Either StoreError a)
+    handleInternal ctxStr e = pure . Left . SEInternalError $ show e <> ctxStr
diff --git a/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs b/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
index 4890bfc22..d2ca386b0 100644
--- a/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
+++ b/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
@@ -20,7 +20,7 @@ CREATE TABLE remote_controllers ( -- controllers known to a hosting app
   remote_controller_id INTEGER PRIMARY KEY,
   display_name TEXT NOT NULL,
   fingerprint BLOB NOT NULL,
-  accepted INTEGER
+  accepted INTEGER -- unknown/rejected/confirmed
 );
 |]
 
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 8e2bedc97..4671f4353 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -15,14 +15,23 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.Map.Strict as M
 import qualified Network.HTTP.Types as HTTP
 import qualified Network.HTTP2.Client as HTTP2Client
+import Network.Socket (SockAddr (..), hostAddressToTuple)
 import Simplex.Chat.Controller
+import qualified Simplex.Chat.Remote.Discovery as Discovery
 import Simplex.Chat.Remote.Types
+import Simplex.Chat.Store.Remote
 import Simplex.Chat.Types
+import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HTTP2
 import qualified Simplex.Messaging.Transport.HTTP2.Server as HTTP2
 import Simplex.Messaging.Util (bshow)
 import System.Directory (getFileSize)
+import UnliftIO
 
 withRemoteHostSession :: (ChatMonad m) => RemoteHostId -> (RemoteHostSession -> m a) -> m a
 withRemoteHostSession remoteHostId action = do
@@ -30,6 +39,17 @@ withRemoteHostSession remoteHostId action = do
   where
     err = throwError $ ChatErrorRemoteHost remoteHostId RHMissing
 
+startRemoteHost :: (ChatMonad m) => RemoteHostId -> m ChatResponse
+startRemoteHost remoteHostId = do
+  RemoteHost {displayName = _, storePath, caKey, caCert} <- error "TODO: get from DB"
+  (fingerprint :: ByteString, sessionCreds) <- error "TODO: derive session creds" (caKey, caCert)
+  cleanup <- toIO $ chatModifyVar remoteHostSessions (M.delete remoteHostId)
+  Discovery.runAnnouncer cleanup fingerprint sessionCreds >>= \case
+    Left todo'err -> pure $ chatCmdError Nothing "TODO: Some HTTP2 error"
+    Right ctrlClient -> do
+      chatModifyVar remoteHostSessions $ M.insert remoteHostId RemoteHostSession {storePath, ctrlClient}
+      pure $ CRRemoteHostStarted remoteHostId
+
 closeRemoteHostSession :: (ChatMonad m) => RemoteHostId -> m ()
 closeRemoteHostSession rh = withRemoteHostSession rh (liftIO . HTTP2.closeHTTP2Client . ctrlClient)
 
@@ -68,10 +88,10 @@ relayCommand RemoteHostSession {ctrlClient} s =
 storeRemoteFile :: (ChatMonad m) => RemoteHostSession -> FilePath -> m ChatResponse
 storeRemoteFile RemoteHostSession {ctrlClient} localFile = do
   postFile Nothing ctrlClient "/store" mempty localFile >>= \case
-    Left e -> error "TODO: http2chatError"
+    Left todo'err -> error "TODO: http2chatError"
     Right HTTP2.HTTP2Response {response} -> case HTTP.statusCode <$> HTTP2Client.responseStatus response of
       Just 200 -> pure $ CRCmdOk Nothing
-      unexpected -> error "TODO: http2chatError"
+      todo'notOk -> error "TODO: http2chatError"
   where
     postFile timeout c path hs file = liftIO $ do
       fileSize <- fromIntegral <$> getFileSize file
@@ -95,11 +115,88 @@ sum2tagged = \case
   J.Object todo'convert -> J.Object todo'convert
   skip -> skip
 
--- withRemoteCtrlSession :: (ChatMonad m) => RemoteCtrlId -> (RemoteCtrlSession -> m a) -> m a
--- withRemoteCtrlSession remoteCtrlId action = do
---   chatReadVar remoteHostSessions >>= maybe err action . M.lookup remoteCtrlId
---   where
---     err = throwError $ ChatErrorRemoteCtrl (Just remoteCtrlId) RCMissing
-
 processControllerCommand :: (ChatMonad m) => RemoteCtrlId -> HTTP2.HTTP2Request -> m ()
 processControllerCommand rc req = error "TODO: processControllerCommand"
+
+-- * ChatRequest handlers
+
+startRemoteCtrl :: (ChatMonad m) => m ChatResponse
+startRemoteCtrl =
+  chatReadVar remoteCtrlSession >>= \case
+    Just _busy -> throwError $ ChatErrorRemoteCtrl RCEBusy
+    Nothing -> do
+      accepted <- newEmptyTMVarIO
+      discovered <- newTVarIO mempty
+      listener <- async $ discoverRemoteCtrls discovered
+      _supervisor <- async $ do
+        uiEvent <- async $ atomically $ readTMVar accepted
+        waitEitherCatchCancel listener uiEvent >>= \case
+          Left _ -> pure () -- discover got cancelled or crashed on some UDP error
+          Right (Left _) -> pure () -- readTMVar blocked indefinitely (should not happen)
+          Right (Right remoteCtrlId) -> do
+            -- got connection confirmation
+            (source, fingerprint) <-
+              atomically $
+                TM.lookup remoteCtrlId discovered >>= \case
+                  Nothing -> error "Session accepted without getting registered"
+                  Just found -> found <$ writeTVar discovered mempty -- flush unused sources
+            host <- async $ runRemoteHost remoteCtrlId source fingerprint
+            chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {ctrlAsync = host, accepted}
+            _ <- waitCatch host
+            chatWriteVar remoteCtrlSession Nothing
+            toView $ CRRemoteCtrlStopped {remoteCtrlId}
+      chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {ctrlAsync = listener, accepted}
+      pure CRRemoteCtrlStarted
+
+discoverRemoteCtrls :: (ChatMonad m) => TM.TMap RemoteCtrlId (TransportHost, C.KeyHash) -> m ()
+discoverRemoteCtrls discovered = Discovery.openListener >>= go
+  where
+    go sock =
+      Discovery.recvAnnounce sock >>= \case
+        (SockAddrInet _port addr, invite) -> case strDecode invite of
+          Left _ -> go sock -- ignore malformed datagrams
+          Right fingerprint -> do
+            withStore' (\db -> getRemoteCtrlByFingerprint (DB.conn db) fingerprint) >>= \case
+              Nothing -> toView $ CRRemoteCtrlAnnounce fingerprint
+              Just found@RemoteCtrl {remoteCtrlId} -> do
+                atomically $ TM.insert remoteCtrlId (THIPv4 (hostAddressToTuple addr), fingerprint) discovered
+                toView $ CRRemoteCtrlFound found
+        _nonV4 -> go sock
+
+runRemoteHost :: (ChatMonad m) => RemoteCtrlId -> TransportHost -> C.KeyHash -> m ()
+runRemoteHost remoteCtrlId remoteCtrlHost fingerprint =
+  Discovery.connectSessionHost remoteCtrlHost fingerprint $ Discovery.attachServer (processControllerCommand remoteCtrlId)
+
+confirmRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
+confirmRemoteCtrl remoteCtrlId =
+  chatReadVar remoteCtrlSession >>= \case
+    Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
+    Just RemoteCtrlSession {accepted} -> do
+      withStore' $ \db -> markRemoteCtrlResolution (DB.conn db) remoteCtrlId True
+      atomically $ putTMVar accepted remoteCtrlId -- the remote host can now proceed with connection
+      pure $ CRRemoteCtrlAccepted {remoteCtrlId}
+
+rejectRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
+rejectRemoteCtrl remoteCtrlId =
+  chatReadVar remoteCtrlSession >>= \case
+    Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
+    Just RemoteCtrlSession {ctrlAsync} -> do
+      withStore' $ \db -> markRemoteCtrlResolution (DB.conn db) remoteCtrlId False
+      cancel ctrlAsync
+      pure $ CRRemoteCtrlRejected {remoteCtrlId}
+
+stopRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
+stopRemoteCtrl remoteCtrlId =
+  chatReadVar remoteCtrlSession >>= \case
+    Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
+    Just RemoteCtrlSession {ctrlAsync} -> do
+      cancel ctrlAsync
+      pure CRRemoteCtrlStopped {remoteCtrlId}
+
+disposeRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
+disposeRemoteCtrl remoteCtrlId =
+  chatReadVar remoteCtrlSession >>= \case
+    Nothing -> do
+      withStore' $ \db -> deleteRemoteCtrl (DB.conn db) remoteCtrlId
+      pure $ CRRemoteCtrlDisposed {remoteCtrlId}
+    Just _ -> throwError $ ChatErrorRemoteCtrl RCEBusy
diff --git a/src/Simplex/Chat/Remote/Discovery.hs b/src/Simplex/Chat/Remote/Discovery.hs
index cb668677f..f04d0a008 100644
--- a/src/Simplex/Chat/Remote/Discovery.hs
+++ b/src/Simplex/Chat/Remote/Discovery.hs
@@ -2,14 +2,22 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 module Simplex.Chat.Remote.Discovery
-  ( runAnnouncer,
-    runDiscoverer,
+  ( -- * Announce
+    runAnnouncer,
+
+    -- * Discovery
+    openListener,
+    recvAnnounce,
+    connectSessionHost,
+    attachServer,
   )
 where
 
 import Control.Monad
+import Data.ByteString (ByteString)
 import Data.Default (def)
 import Data.String (IsString)
 import Debug.Trace
@@ -28,6 +36,13 @@ import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTran
 import UnliftIO
 import UnliftIO.Concurrent
 
+-- | Link-local broadcast address.
+pattern BROADCAST_ADDR_V4 :: (IsString a, Eq a) => a
+pattern BROADCAST_ADDR_V4 = "255.255.255.255"
+
+pattern BROADCAST_PORT :: (IsString a, Eq a) => a
+pattern BROADCAST_PORT = "5226"
+
 runAnnouncer :: (StrEncoding invite, MonadUnliftIO m) => IO () -> invite -> TLS.Credentials -> m (Either HTTP2ClientError HTTP2Client)
 runAnnouncer finished invite credentials = do
   started <- newEmptyTMVarIO
@@ -40,7 +55,7 @@ runAnnouncer finished invite credentials = do
             TLS.serverSupported = supportedParameters
           }
   httpClient <- newEmptyMVar
-  liftIO $ runTransportServer started partyPort serverParams defaultTransportServerConfig (run aPid httpClient)
+  liftIO $ runTransportServer started BROADCAST_PORT serverParams defaultTransportServerConfig (run aPid httpClient)
   takeMVar httpClient
   where
     announcer started inviteBS = do
@@ -48,10 +63,10 @@ runAnnouncer finished invite credentials = do
         False ->
           error "Server not started?.."
         True -> liftIO $ do
-          traceM $ "TCP server started at " <> partyPort
-          sock <- UDP.clientSocket broadcastAddrV4 partyPort False
+          traceM $ "TCP server started at " <> BROADCAST_PORT
+          sock <- UDP.clientSocket BROADCAST_ADDR_V4 BROADCAST_PORT False
           N.setSocketOption (UDP.udpSocket sock) N.Broadcast 1
-          traceM $ "UDP announce started at " <> broadcastAddrV4 <> ":" <> partyPort
+          traceM $ "UDP announce started at " <> BROADCAST_ADDR_V4 <> ":" <> BROADCAST_PORT
           traceM $ "Server invite: " <> show inviteBS
           forever $ do
             UDP.send sock inviteBS
@@ -61,47 +76,25 @@ runAnnouncer finished invite credentials = do
     run aPid clientVar tls = do
       cancel aPid
       let partyHost = "255.255.255.255" -- XXX: get from tls somehow? not required as host verification is disabled.
-      attachHTTP2Client defaultHTTP2ClientConfig partyHost partyPort finished defaultHTTP2BufferSize tls >>= putMVar clientVar
+      attachHTTP2Client defaultHTTP2ClientConfig partyHost BROADCAST_PORT finished defaultHTTP2BufferSize tls >>= putMVar clientVar
 
--- | Link-local broadcast address.
-broadcastAddrV4 :: (IsString a) => a
-broadcastAddrV4 = "255.255.255.255"
-
-partyPort :: (IsString a) => a
-partyPort = "5226" -- XXX: should be `0` or something, to get a random port and announce it
-
-runDiscoverer :: IO [(C.KeyHash, ctx)] -> (ctx -> IO Bool) -> (ctx -> Maybe SomeException -> IO ()) -> (ctx -> HTTP2Request -> IO ()) -> IO ()
-runDiscoverer getFingerprints started finished processRequest = do
-  sock <- UDP.serverSocket (broadcastAddrV4, read partyPort)
+openListener :: (MonadIO m) => m UDP.ListenSocket
+openListener = liftIO $ do
+  sock <- UDP.serverSocket (BROADCAST_ADDR_V4, read BROADCAST_PORT)
   N.setSocketOption (UDP.listenSocket sock) N.Broadcast 1
-  traceM $ "runDiscoverer: " <> show sock
-  go sock
-  where
-    go sock = do
-      (invite, UDP.ClientSockAddr source _cmsg) <- UDP.recvFrom sock
-      case strDecode invite of
-        Left err -> do
-          traceM $ "Inivite decode error: " <> err
-          go sock
-        Right inviteHash -> do
-          expected <- getFingerprints
-          case lookup inviteHash expected of
-            Nothing -> do
-              traceM $ "Unexpected invite: " <> show (invite, source)
-              go sock
-            Just ctx -> do
-              host <- case source of
-                N.SockAddrInet _port addr -> do
-                  pure $ THIPv4 (N.hostAddressToTuple addr)
-                unexpected ->
-                  -- TODO: actually, Apple mandates IPv6 support
-                  fail $ "Discoverer: expected an IPv4 party, got " <> show unexpected
-              runTransportClient defaultTransportClientConfig Nothing host partyPort (Just inviteHash) $ \tls -> do
-                accepted <- started ctx
-                if not accepted
-                  then go sock -- Ignore rejected invites and wait for another
-                  else do
-                    res <- try $ runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
-                      reqBody <- getHTTP2Body r 16384
-                      processRequest ctx HTTP2Request {sessionId, request = r, reqBody, sendResponse}
-                    finished ctx $ either Just (\() -> Nothing) res
+  pure sock
+
+recvAnnounce :: (MonadIO m) => UDP.ListenSocket -> m (N.SockAddr, ByteString)
+recvAnnounce sock = liftIO $ do
+  (invite, UDP.ClientSockAddr source _cmsg) <- UDP.recvFrom sock
+  pure (source, invite)
+
+connectSessionHost :: (MonadUnliftIO m) => TransportHost -> C.KeyHash -> (Transport.TLS -> m a) -> m a
+connectSessionHost host caFingerprint = runTransportClient defaultTransportClientConfig Nothing host BROADCAST_PORT (Just caFingerprint)
+
+attachServer :: (MonadUnliftIO m) => (HTTP2Request -> m ()) -> Transport.TLS -> m ()
+attachServer processRequest tls = do
+  withRunInIO $ \unlift ->
+    runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
+      reqBody <- getHTTP2Body r defaultHTTP2BufferSize
+      unlift $ processRequest HTTP2Request {sessionId, request = r, reqBody, sendResponse}
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index 53f73c338..fa9b3fb35 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -1,11 +1,15 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 
 module Simplex.Chat.Remote.Types where
 
 import Control.Concurrent.Async (Async)
+import Data.Aeson (ToJSON)
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.Text (Text)
+import GHC.Generics (Generic)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import UnliftIO.STM
@@ -22,6 +26,7 @@ data RemoteHost = RemoteHost
     -- | Credentials signing key for root and session certs
     caKey :: C.Key
   }
+  deriving (Show)
 
 type RemoteCtrlId = Int64
 
@@ -31,6 +36,7 @@ data RemoteCtrl = RemoteCtrl
     fingerprint :: C.KeyHash,
     accepted :: Maybe Bool
   }
+  deriving (Show, Generic, ToJSON)
 
 data RemoteHostSession = RemoteHostSession
   { -- | Path for local resources to be synchronized with host
@@ -41,5 +47,5 @@ data RemoteHostSession = RemoteHostSession
 data RemoteCtrlSession = RemoteCtrlSession
   { -- | Server side of transport to process remote commands and forward notifications
     ctrlAsync :: Async (),
-    accepted :: TMVar Bool
+    accepted :: TMVar RemoteCtrlId
   }
diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs
index f185000d8..591f346be 100644
--- a/src/Simplex/Chat/Store/Remote.hs
+++ b/src/Simplex/Chat/Store/Remote.hs
@@ -37,6 +37,11 @@ getRemoteCtrl db remoteCtrlId =
   maybeFirstRow toRemoteCtrl $
     DB.query db (remoteCtrlQuery <> "WHERE remote_controller_id = ?") (DB.Only remoteCtrlId)
 
+getRemoteCtrlByFingerprint :: DB.Connection -> C.KeyHash -> IO (Maybe RemoteCtrl)
+getRemoteCtrlByFingerprint db fingerprint =
+  maybeFirstRow toRemoteCtrl $
+    DB.query db (remoteCtrlQuery <> "WHERE fingerprint = ?") (DB.Only fingerprint)
+
 remoteCtrlQuery :: DB.Query
 remoteCtrlQuery = "SELECT remote_controller_id, display_name, fingerprint, accepted FROM remote_controllers"
 
@@ -46,7 +51,7 @@ toRemoteCtrl (remoteCtrlId, displayName, fingerprint, accepted) =
 
 markRemoteCtrlResolution :: DB.Connection -> RemoteCtrlId -> Bool -> IO ()
 markRemoteCtrlResolution db remoteCtrlId accepted =
-  DB.execute db "UPDATE remote_controllers SET accepted = ? WHERE remote_controller_id = ?" (accepted, remoteCtrlId)
+  DB.execute db "UPDATE remote_controllers SET accepted = ? WHERE remote_controller_id = ? AND accepted IS NULL" (accepted, remoteCtrlId)
 
 deleteRemoteCtrl :: DB.Connection -> RemoteCtrlId -> IO ()
 deleteRemoteCtrl db remoteCtrlId =

From 6c0d1b5f153266cd62b00e709a8be1b6c3e7f60a Mon Sep 17 00:00:00 2001
From: IC Rainbow <aenor.realm@gmail.com>
Date: Fri, 29 Sep 2023 16:53:05 +0300
Subject: [PATCH 05/69] Notify about handover errors

---
 cabal.project                    |  2 +-
 src/Simplex/Chat/Controller.hs   |  2 +-
 src/Simplex/Chat/Remote.hs       | 23 +++++++++++------------
 src/Simplex/Chat/Remote/Types.hs |  8 +++++++-
 4 files changed, 20 insertions(+), 15 deletions(-)

diff --git a/cabal.project b/cabal.project
index 7d7339a7f..af664652d 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: 681fa93bf342d7c836fa0ff69b767dcd08526f03
+    tag: ec1b72cb8013a65a5d9783104a47ae44f5730089
 
 source-repository-package
     type: git
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 0598bba8f..690f78ea4 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -913,7 +913,7 @@ data ChatError
   | ChatErrorAgent {agentError :: AgentErrorType, connectionEntity_ :: Maybe ConnectionEntity}
   | ChatErrorStore {storeError :: StoreError}
   | ChatErrorDatabase {databaseError :: DatabaseError}
-  | ChatErrorRemoteCtrl {remoteControllerError :: RemoteCtrlError}
+  | ChatErrorRemoteCtrl {remoteCtrlError :: RemoteCtrlError}
   | ChatErrorRemoteHost {remoteHostId :: RemoteHostId, remoteHostError :: RemoteHostError}
   deriving (Show, Exception, Generic)
 
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 4671f4353..82d2e9e63 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -132,19 +132,18 @@ startRemoteCtrl =
         uiEvent <- async $ atomically $ readTMVar accepted
         waitEitherCatchCancel listener uiEvent >>= \case
           Left _ -> pure () -- discover got cancelled or crashed on some UDP error
-          Right (Left _) -> pure () -- readTMVar blocked indefinitely (should not happen)
-          Right (Right remoteCtrlId) -> do
+          Right (Left _) -> toView . CRChatError Nothing . ChatError $ CEException "Crashed while waiting for remote session confirmation"
+          Right (Right remoteCtrlId) ->
             -- got connection confirmation
-            (source, fingerprint) <-
-              atomically $
-                TM.lookup remoteCtrlId discovered >>= \case
-                  Nothing -> error "Session accepted without getting registered"
-                  Just found -> found <$ writeTVar discovered mempty -- flush unused sources
-            host <- async $ runRemoteHost remoteCtrlId source fingerprint
-            chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {ctrlAsync = host, accepted}
-            _ <- waitCatch host
-            chatWriteVar remoteCtrlSession Nothing
-            toView $ CRRemoteCtrlStopped {remoteCtrlId}
+            atomically (TM.lookup remoteCtrlId discovered) >>= \case
+              Nothing -> toView . CRChatError Nothing . ChatError $ CEInternalError "Remote session accepted without getting discovered first"
+              Just (source, fingerprint) -> do
+                atomically $ writeTVar discovered mempty -- flush unused sources
+                host <- async $ runRemoteHost remoteCtrlId source fingerprint
+                chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {ctrlAsync = host, accepted}
+                _ <- waitCatch host
+                chatWriteVar remoteCtrlSession Nothing
+                toView $ CRRemoteCtrlStopped {remoteCtrlId}
       chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {ctrlAsync = listener, accepted}
       pure CRRemoteCtrlStarted
 
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index fa9b3fb35..5902476fc 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -5,7 +5,7 @@
 module Simplex.Chat.Remote.Types where
 
 import Control.Concurrent.Async (Async)
-import Data.Aeson (ToJSON)
+import Data.Aeson (ToJSON (..))
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.Text (Text)
@@ -13,6 +13,7 @@ import GHC.Generics (Generic)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import UnliftIO.STM
+import Simplex.Messaging.Encoding.String (strToJEncoding, strToJSON)
 
 type RemoteHostId = Int64
 
@@ -38,6 +39,11 @@ data RemoteCtrl = RemoteCtrl
   }
   deriving (Show, Generic, ToJSON)
 
+-- XXX: until fixed in master
+instance ToJSON C.KeyHash where
+  toEncoding = strToJEncoding
+  toJSON = strToJSON
+
 data RemoteHostSession = RemoteHostSession
   { -- | Path for local resources to be synchronized with host
     storePath :: FilePath,

From 0bcf5c9c66e82b2aee2bac2b39b4648d96cc6e7d Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Wed, 4 Oct 2023 18:36:10 +0300
Subject: [PATCH 06/69] Add commands for remote session credentials (#3161)

* Add remote host commands

* Make startRemoteHost async

* Add tests

* Trim randomStorePath to 16 chars

* Add chat command tests

* add view, use view output in test

* enable all tests

* Fix discovery listener host

Must use any, not broadcast on macos.

* Fix missing do

* address, names

* Fix session host flow

* fix test

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 cabal.project                                 |   2 +-
 simplex-chat.cabal                            |   1 +
 src/Simplex/Chat.hs                           |  29 +--
 src/Simplex/Chat/Controller.hs                |  29 ++-
 .../Migrations/M20230922_remote_controller.hs |  19 +-
 src/Simplex/Chat/Migrations/chat_schema.sql   |  18 +-
 src/Simplex/Chat/Remote.hs                    | 238 ++++++++++++------
 src/Simplex/Chat/Remote/Discovery.hs          | 100 ++++----
 src/Simplex/Chat/Remote/Types.hs              |  38 +--
 src/Simplex/Chat/Store/Remote.hs              |  42 ++--
 src/Simplex/Chat/View.hs                      |  46 +++-
 tests/RemoteTests.hs                          | 148 +++++++++++
 tests/Test.hs                                 |   2 +
 13 files changed, 515 insertions(+), 197 deletions(-)
 create mode 100644 tests/RemoteTests.hs

diff --git a/cabal.project b/cabal.project
index af664652d..f5bb87976 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: ec1b72cb8013a65a5d9783104a47ae44f5730089
+    tag: 753a6c7542c3764fda9ce3f4c4cdc9f2329816d3
 
 source-repository-package
     type: git
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 986c4966b..75ca58c43 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -490,6 +490,7 @@ test-suite simplex-chat-test
       MarkdownTests
       MobileTests
       ProtocolTests
+      RemoteTests
       SchemaDump
       ViewTests
       WebRTCTests
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 92a29b7ac..0112b7637 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1835,18 +1835,18 @@ processChatCommand = \case
     let pref = uncurry TimedMessagesGroupPreference $ maybe (FEOff, Just 86400) (\ttl -> (FEOn, Just ttl)) ttl_
     updateGroupProfileByName gName $ \p ->
       p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
-  CreateRemoteHost _displayName -> pure $ chatCmdError Nothing "not supported"
-  ListRemoteHosts -> pure $ chatCmdError Nothing "not supported"
+  CreateRemoteHost -> createRemoteHost
+  ListRemoteHosts -> listRemoteHosts
   StartRemoteHost rh -> startRemoteHost rh
-  StopRemoteHost rh -> closeRemoteHostSession rh $> CRRemoteHostStopped rh
-  DisposeRemoteHost _rh -> pure $ chatCmdError Nothing "not supported"
+  StopRemoteHost rh -> closeRemoteHostSession rh
+  DeleteRemoteHost rh -> deleteRemoteHost rh
   StartRemoteCtrl -> startRemoteCtrl
-  ConfirmRemoteCtrl rc -> confirmRemoteCtrl rc
+  AcceptRemoteCtrl rc -> acceptRemoteCtrl rc
   RejectRemoteCtrl rc -> rejectRemoteCtrl rc
   StopRemoteCtrl rc -> stopRemoteCtrl rc
-  RegisterRemoteCtrl _displayName _oobData -> pure $ chatCmdError Nothing "not supported"
-  ListRemoteCtrls -> pure $ chatCmdError Nothing "not supported"
-  DisposeRemoteCtrl rc -> disposeRemoteCtrl rc
+  RegisterRemoteCtrl oob -> registerRemoteCtrl oob
+  ListRemoteCtrls -> listRemoteCtrls
+  DeleteRemoteCtrl rc -> deleteRemoteCtrl rc
   QuitChat -> liftIO exitSuccess
   ShowVersion -> do
     let versionInfo = coreVersionInfo $(simplexmqCommitQ)
@@ -5609,17 +5609,19 @@ chatCommandP =
       "/set disappear @" *> (SetContactTimedMessages <$> displayName <*> optional (A.space *> timedMessagesEnabledP)),
       "/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))),
       ("/incognito" <* optional (A.space *> onOffP)) $> ChatHelp HSIncognito,
-      "/create remote host" *> (CreateRemoteHost <$> textP),
+      "/create remote host" $> CreateRemoteHost,
       "/list remote hosts" $> ListRemoteHosts,
       "/start remote host " *> (StartRemoteHost <$> A.decimal),
       "/stop remote host " *> (StopRemoteHost <$> A.decimal),
-      "/dispose remote host " *> (DisposeRemoteHost <$> A.decimal),
+      "/delete remote host " *> (DeleteRemoteHost <$> A.decimal),
       "/start remote ctrl" $> StartRemoteCtrl,
-      "/register remote ctrl " *> (RegisterRemoteCtrl <$> textP <*> remoteHostOOBP),
-      "/confirm remote ctrl " *> (ConfirmRemoteCtrl <$> A.decimal),
+      -- TODO *** you need to pass multiple parameters here
+      "/register remote ctrl " *> (RegisterRemoteCtrl <$> (RemoteCtrlOOB <$> strP)),
+      "/list remote ctrls" $> ListRemoteCtrls,
+      "/accept remote ctrl " *> (AcceptRemoteCtrl <$> A.decimal),
       "/reject remote ctrl " *> (RejectRemoteCtrl <$> A.decimal),
       "/stop remote ctrl " *> (StopRemoteCtrl <$> A.decimal),
-      "/dispose remote ctrl " *> (DisposeRemoteCtrl <$> A.decimal),
+      "/delete remote ctrl " *> (DeleteRemoteCtrl <$> A.decimal),
       ("/quit" <|> "/q" <|> "/exit") $> QuitChat,
       ("/version" <|> "/v") $> ShowVersion,
       "/debug locks" $> DebugLocks,
@@ -5737,7 +5739,6 @@ chatCommandP =
     srvCfgP = strP >>= \case AProtocolType p -> APSC p <$> (A.space *> jsonP)
     toServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True}
     char_ = optional . A.char
-    remoteHostOOBP = RemoteHostOOB <$> textP
 
 adminContactReq :: ConnReqContact
 adminContactReq =
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index a5f3d55b6..9266e2292 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -414,18 +414,18 @@ data ChatCommand
   | SetUserTimedMessages Bool -- UserId (not used in UI)
   | SetContactTimedMessages ContactName (Maybe TimedMessagesEnabled)
   | SetGroupTimedMessages GroupName (Maybe Int)
-  | CreateRemoteHost Text -- ^ Configure a new remote host
+  | CreateRemoteHost -- ^ Configure a new remote host
   | ListRemoteHosts
   | StartRemoteHost RemoteHostId -- ^ Start and announce a remote host
   | StopRemoteHost RemoteHostId -- ^ Shut down a running session
-  | DisposeRemoteHost RemoteHostId -- ^ Unregister remote host and remove its data
-  | RegisterRemoteCtrl Text RemoteHostOOB -- ^ Register OOB data for satellite discovery and handshake
+  | DeleteRemoteHost RemoteHostId -- ^ Unregister remote host and remove its data
+  | RegisterRemoteCtrl RemoteCtrlOOB -- ^ Register OOB data for satellite discovery and handshake
   | StartRemoteCtrl -- ^ Start listening for announcements from all registered controllers
   | ListRemoteCtrls
-  | ConfirmRemoteCtrl RemoteCtrlId -- ^ Confirm discovered data and store confirmation
+  | AcceptRemoteCtrl RemoteCtrlId -- ^ Accept discovered data and store confirmation
   | RejectRemoteCtrl RemoteCtrlId -- ^ Reject and blacklist discovered data
   | StopRemoteCtrl RemoteCtrlId -- ^ Stop listening for announcements or terminate an active session
-  | DisposeRemoteCtrl RemoteCtrlId -- ^ Remove all local data associated with a satellite session
+  | DeleteRemoteCtrl RemoteCtrlId -- ^ Remove all local data associated with a satellite session
   | QuitChat
   | ShowVersion
   | DebugLocks
@@ -597,22 +597,23 @@ data ChatResponse
   | CRNtfMessages {user_ :: Maybe User, connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}
   | CRNewContactConnection {user :: User, connection :: PendingContactConnection}
   | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
-  | CRRemoteHostCreated {remoteHostId :: RemoteHostId, oobData :: RemoteHostOOB}
+  | CRRemoteHostCreated {remoteHostId :: RemoteHostId, oobData :: RemoteCtrlOOB}
   | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]} -- XXX: RemoteHostInfo is mostly concerned with session setup
   | CRRemoteHostStarted {remoteHostId :: RemoteHostId}
+  | CRRemoteHostConnected {remoteHostId :: RemoteHostId}
   | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
-  | CRRemoteHostDisposed {remoteHostId :: RemoteHostId}
+  | CRRemoteHostDeleted {remoteHostId :: RemoteHostId}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlRegistered {remoteCtrlId :: RemoteCtrlId}
   | CRRemoteCtrlStarted
   | CRRemoteCtrlAnnounce {fingerprint :: C.KeyHash} -- unregistered fingerprint, needs confirmation
-  | CRRemoteCtrlFound {remoteCtrl::RemoteCtrl} -- registered fingerprint, may connect
-  -- | CRRemoteCtrlFirstContact {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
+  | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrl} -- registered fingerprint, may connect
   | CRRemoteCtrlAccepted {remoteCtrlId :: RemoteCtrlId}
   | CRRemoteCtrlRejected {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlConnecting {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
   | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
   | CRRemoteCtrlStopped {remoteCtrlId :: RemoteCtrlId}
-  | CRRemoteCtrlDisposed {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlDeleted {remoteCtrlId :: RemoteCtrlId}
   | CRSQLResult {rows :: [Text]}
   | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
   | CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks}
@@ -656,13 +657,14 @@ instance ToJSON ChatResponse where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
 
-data RemoteHostOOB = RemoteHostOOB
-  { fingerprint :: Text -- CA key fingerprint
+data RemoteCtrlOOB = RemoteCtrlOOB
+  { caFingerprint :: C.KeyHash
   }
   deriving (Show, Generic, ToJSON)
 
 data RemoteHostInfo = RemoteHostInfo
   { remoteHostId :: RemoteHostId,
+    storePath :: FilePath,
     displayName :: Text,
     sessionActive :: Bool
   }
@@ -673,7 +675,7 @@ data RemoteCtrlInfo = RemoteCtrlInfo
     displayName :: Text,
     sessionActive :: Bool
   }
-  deriving (Show, Generic, ToJSON)
+  deriving (Eq, Show, Generic, ToJSON)
 
 newtype UserPwd = UserPwd {unUserPwd :: Text}
   deriving (Eq, Show)
@@ -1052,6 +1054,7 @@ data RemoteCtrlError
   | RCEConnectionLost {remoteCtrlId :: RemoteCtrlId, reason :: Text} -- ^ A session disconnected due to transport issues
   | RCECertificateExpired {remoteCtrlId :: RemoteCtrlId} -- ^ A connection or CA certificate in a chain have bad validity period
   | RCECertificateUntrusted {remoteCtrlId :: RemoteCtrlId} -- ^ TLS is unable to validate certificate chain presented for a connection
+  | RCEBadFingerprint -- ^ Bad fingerprint data provided in OOB
   deriving (Show, Exception, Generic)
 
 instance FromJSON RemoteCtrlError where
diff --git a/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs b/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
index d2ca386b0..21d653d12 100644
--- a/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
+++ b/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
@@ -9,18 +9,19 @@ m20230922_remote_controller :: Query
 m20230922_remote_controller =
   [sql|
 CREATE TABLE remote_hosts ( -- hosts known to a controlling app
-  remote_host_id INTEGER PRIMARY KEY,
-  display_name TEXT NOT NULL,
-  store_path TEXT NOT NULL,
-  ca_cert BLOB NOT NULL,
-  ca_key BLOB NOT NULL
+  remote_host_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  store_path TEXT NOT NULL,            -- file path relative to app store (must not contain "/")
+  display_name TEXT NOT NULL,          -- user-provided name for a remote host
+  ca_key BLOB NOT NULL,                -- private key for signing session certificates
+  ca_cert BLOB NOT NULL,               -- root certificate, whose fingerprint is pinned on a remote
+  contacted INTEGER NOT NULL DEFAULT 0 -- 0 (first time), 1 (connected before)
 );
 
 CREATE TABLE remote_controllers ( -- controllers known to a hosting app
-  remote_controller_id INTEGER PRIMARY KEY,
-  display_name TEXT NOT NULL,
-  fingerprint BLOB NOT NULL,
-  accepted INTEGER -- unknown/rejected/confirmed
+  remote_controller_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  display_name TEXT NOT NULL, -- user-provided name for a remote controller
+  fingerprint BLOB NOT NULL,  -- remote controller CA fingerprint
+  accepted INTEGER            -- NULL (unknown), 0 (rejected), 1 (confirmed)
 );
 |]
 
diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql
index e6be03bcc..36ebe6120 100644
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -518,17 +518,19 @@ CREATE TABLE IF NOT EXISTS "received_probes"(
 );
 CREATE TABLE remote_hosts(
   -- hosts known to a controlling app
-  remote_host_id INTEGER PRIMARY KEY,
-  display_name TEXT NOT NULL,
-  store_path TEXT NOT NULL,
-  ca_cert BLOB NOT NULL,
-  ca_key BLOB NOT NULL
+  remote_host_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  store_path TEXT NOT NULL, -- file path relative to app store(must not contain "/")
+  display_name TEXT NOT NULL, -- user-provided name for a remote host
+  ca_key BLOB NOT NULL, -- private key for signing session certificates
+  ca_cert BLOB NOT NULL, -- root certificate, whose fingerprint is pinned on a remote
+  contacted INTEGER NOT NULL DEFAULT 0 -- 0(first time), 1(connected before)
 );
 CREATE TABLE remote_controllers(
   -- controllers known to a hosting app
-  remote_controller_id INTEGER PRIMARY KEY,
-  display_name TEXT NOT NULL,
-  fingerprint BLOB NOT NULL
+  remote_controller_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  display_name TEXT NOT NULL, -- user-provided name for a remote controller
+  fingerprint BLOB NOT NULL, -- remote controller CA fingerprint
+  accepted INTEGER -- NULL(unknown), 0(rejected), 1(confirmed)
 );
 CREATE INDEX contact_profiles_index ON contact_profiles(
   display_name,
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 82d2e9e63..936c750c6 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -7,11 +7,17 @@
 
 module Simplex.Chat.Remote where
 
+import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
+import Control.Monad.STM (retry)
+import Crypto.Random (getRandomBytes)
 import qualified Data.Aeson as J
 import qualified Data.Binary.Builder as Binary
-import Data.ByteString.Char8 (ByteString)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Base64.URL as B64U
+import qualified Data.ByteString.Char8 as B
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as M
 import qualified Network.HTTP.Types as HTTP
 import qualified Network.HTTP2.Client as HTTP2Client
@@ -21,12 +27,13 @@ import qualified Simplex.Chat.Remote.Discovery as Discovery
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store.Remote
 import Simplex.Chat.Types
-import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HTTP2
 import qualified Simplex.Messaging.Transport.HTTP2.Server as HTTP2
 import Simplex.Messaging.Util (bshow)
@@ -39,29 +46,82 @@ withRemoteHostSession remoteHostId action = do
   where
     err = throwError $ ChatErrorRemoteHost remoteHostId RHMissing
 
+withRemoteHost :: (ChatMonad m) => RemoteHostId -> (RemoteHost -> m a) -> m a
+withRemoteHost remoteHostId action =
+  withStore' (`getRemoteHost` remoteHostId) >>= \case
+    Nothing -> throwError $ ChatErrorRemoteHost remoteHostId RHMissing
+    Just rh -> action rh
+
 startRemoteHost :: (ChatMonad m) => RemoteHostId -> m ChatResponse
 startRemoteHost remoteHostId = do
-  RemoteHost {displayName = _, storePath, caKey, caCert} <- error "TODO: get from DB"
-  (fingerprint :: ByteString, sessionCreds) <- error "TODO: derive session creds" (caKey, caCert)
-  cleanup <- toIO $ chatModifyVar remoteHostSessions (M.delete remoteHostId)
-  Discovery.runAnnouncer cleanup fingerprint sessionCreds >>= \case
-    Left todo'err -> pure $ chatCmdError Nothing "TODO: Some HTTP2 error"
-    Right ctrlClient -> do
-      chatModifyVar remoteHostSessions $ M.insert remoteHostId RemoteHostSession {storePath, ctrlClient}
-      pure $ CRRemoteHostStarted remoteHostId
+  M.lookup remoteHostId <$> chatReadVar remoteHostSessions >>= \case
+    Just _ -> throwError $ ChatErrorRemoteHost remoteHostId RHBusy
+    Nothing -> withRemoteHost remoteHostId run
+  where
+    run RemoteHost {storePath, caKey, caCert} = do
+      announcer <- async $ do
+        cleanup <- toIO $ closeRemoteHostSession remoteHostId >>= toView
+        let parent = (C.signatureKeyPair caKey, caCert)
+        sessionCreds <- liftIO $ genCredentials (Just parent) (0, 24) "Session"
+        let (fingerprint, credentials) = tlsCredentials $ sessionCreds :| [parent]
+        Discovery.announceRevHTTP2 cleanup fingerprint credentials >>= \case
+          Left todo'err -> liftIO cleanup -- TODO: log error
+          Right ctrlClient -> do
+            chatModifyVar remoteHostSessions $ M.insert remoteHostId RemoteHostSessionStarted {storePath, ctrlClient}
+            -- TODO: start streaming outputQ
+            toView CRRemoteHostConnected {remoteHostId}
+      chatModifyVar remoteHostSessions $ M.insert remoteHostId RemoteHostSessionStarting {announcer}
+      pure CRRemoteHostStarted {remoteHostId}
 
-closeRemoteHostSession :: (ChatMonad m) => RemoteHostId -> m ()
-closeRemoteHostSession rh = withRemoteHostSession rh (liftIO . HTTP2.closeHTTP2Client . ctrlClient)
+closeRemoteHostSession :: (ChatMonad m) => RemoteHostId -> m ChatResponse
+closeRemoteHostSession remoteHostId = withRemoteHostSession remoteHostId $ \session -> do
+  case session of
+    RemoteHostSessionStarting {announcer} -> cancel announcer
+    RemoteHostSessionStarted {ctrlClient} -> liftIO (HTTP2.closeHTTP2Client ctrlClient)
+  chatModifyVar remoteHostSessions $ M.delete remoteHostId
+  pure CRRemoteHostStopped { remoteHostId }
+
+createRemoteHost :: (ChatMonad m) => m ChatResponse
+createRemoteHost = do
+  let displayName = "TODO" -- you don't have remote host name here, it will be passed from remote host
+  ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) displayName
+  storePath <- liftIO randomStorePath
+  remoteHostId <- withStore' $ \db -> insertRemoteHost db storePath displayName caKey caCert
+  let oobData =
+        RemoteCtrlOOB
+          { caFingerprint = C.certificateFingerprint caCert
+          }
+  pure CRRemoteHostCreated {remoteHostId, oobData}
+
+-- | Generate a random 16-char filepath without / in it by using base64url encoding.
+randomStorePath :: IO FilePath
+randomStorePath = B.unpack . B64U.encode <$> getRandomBytes 12
+
+listRemoteHosts :: (ChatMonad m) => m ChatResponse
+listRemoteHosts = do
+  stored <- withStore' getRemoteHosts
+  active <- chatReadVar remoteHostSessions
+  pure $ CRRemoteHostList $ do
+    RemoteHost {remoteHostId, storePath, displayName} <- stored
+    let sessionActive = M.member remoteHostId active
+    pure RemoteHostInfo {remoteHostId, storePath, displayName, sessionActive}
+
+deleteRemoteHost :: (ChatMonad m) => RemoteHostId -> m ChatResponse
+deleteRemoteHost remoteHostId = withRemoteHost remoteHostId $ \rh -> do
+  -- TODO: delete files
+  withStore' $ \db -> deleteRemoteHostRecord db remoteHostId
+  pure CRRemoteHostDeleted {remoteHostId}
 
 processRemoteCommand :: (ChatMonad m) => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
-processRemoteCommand rhs = \case
+processRemoteCommand RemoteHostSessionStarting {} _ = error "TODO: sending remote commands before session started"
+processRemoteCommand RemoteHostSessionStarted {ctrlClient} (s, cmd) =
   -- XXX: intercept and filter some commands
   -- TODO: store missing files on remote host
-  (s, _cmd) -> relayCommand rhs s
+  relayCommand ctrlClient s
 
-relayCommand :: (ChatMonad m) => RemoteHostSession -> ByteString -> m ChatResponse
-relayCommand RemoteHostSession {ctrlClient} s =
-  postBytestring Nothing ctrlClient "/relay" mempty s >>= \case
+relayCommand :: (ChatMonad m) => HTTP2Client -> ByteString -> m ChatResponse
+relayCommand http s =
+  postBytestring Nothing http "/relay" mempty s >>= \case
     Left e -> error "TODO: http2chatError"
     Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
       remoteChatResponse <-
@@ -85,9 +145,15 @@ relayCommand RemoteHostSession {ctrlClient} s =
       where
         req = HTTP2Client.requestBuilder "POST" path hs (Binary.fromByteString body)
 
-storeRemoteFile :: (ChatMonad m) => RemoteHostSession -> FilePath -> m ChatResponse
-storeRemoteFile RemoteHostSession {ctrlClient} localFile = do
-  postFile Nothing ctrlClient "/store" mempty localFile >>= \case
+-- | Convert swift single-field sum encoding into tagged/discriminator-field
+sum2tagged :: J.Value -> J.Value
+sum2tagged = \case
+  J.Object todo'convert -> J.Object todo'convert
+  skip -> skip
+
+storeRemoteFile :: (ChatMonad m) => HTTP2Client -> FilePath -> m ChatResponse
+storeRemoteFile http localFile = do
+  postFile Nothing http "/store" mempty localFile >>= \case
     Left todo'err -> error "TODO: http2chatError"
     Right HTTP2.HTTP2Response {response} -> case HTTP.statusCode <$> HTTP2Client.responseStatus response of
       Just 200 -> pure $ CRCmdOk Nothing
@@ -99,9 +165,9 @@ storeRemoteFile RemoteHostSession {ctrlClient} localFile = do
       where
         req size = HTTP2Client.requestFile "POST" path hs (HTTP2Client.FileSpec file 0 size)
 
-fetchRemoteFile :: (ChatMonad m) => RemoteHostSession -> FileTransferId -> m ChatResponse
-fetchRemoteFile RemoteHostSession {ctrlClient, storePath} remoteFileId = do
-  liftIO (HTTP2.sendRequest ctrlClient req Nothing) >>= \case
+fetchRemoteFile :: (ChatMonad m) => HTTP2Client -> FilePath -> FileTransferId -> m ChatResponse
+fetchRemoteFile http storePath remoteFileId = do
+  liftIO (HTTP2.sendRequest http req Nothing) >>= \case
     Left e -> error "TODO: http2chatError"
     Right HTTP2.HTTP2Response {respBody} -> do
       error "TODO: stream body into a local file" -- XXX: consult headers for a file name?
@@ -109,14 +175,8 @@ fetchRemoteFile RemoteHostSession {ctrlClient, storePath} remoteFileId = do
     req = HTTP2Client.requestNoBody "GET" path mempty
     path = "/fetch/" <> bshow remoteFileId
 
--- | Convert swift single-field sum encoding into tagged/discriminator-field
-sum2tagged :: J.Value -> J.Value
-sum2tagged = \case
-  J.Object todo'convert -> J.Object todo'convert
-  skip -> skip
-
-processControllerCommand :: (ChatMonad m) => RemoteCtrlId -> HTTP2.HTTP2Request -> m ()
-processControllerCommand rc req = error "TODO: processControllerCommand"
+processControllerRequest :: (ChatMonad m) => RemoteCtrlId -> HTTP2.HTTP2Request -> m ()
+processControllerRequest rc req = error "TODO: processControllerRequest"
 
 -- * ChatRequest handlers
 
@@ -127,27 +187,23 @@ startRemoteCtrl =
     Nothing -> do
       accepted <- newEmptyTMVarIO
       discovered <- newTVarIO mempty
-      listener <- async $ discoverRemoteCtrls discovered
-      _supervisor <- async $ do
-        uiEvent <- async $ atomically $ readTMVar accepted
-        waitEitherCatchCancel listener uiEvent >>= \case
-          Left _ -> pure () -- discover got cancelled or crashed on some UDP error
-          Right (Left _) -> toView . CRChatError Nothing . ChatError $ CEException "Crashed while waiting for remote session confirmation"
-          Right (Right remoteCtrlId) ->
-            -- got connection confirmation
-            atomically (TM.lookup remoteCtrlId discovered) >>= \case
-              Nothing -> toView . CRChatError Nothing . ChatError $ CEInternalError "Remote session accepted without getting discovered first"
-              Just (source, fingerprint) -> do
-                atomically $ writeTVar discovered mempty -- flush unused sources
-                host <- async $ runRemoteHost remoteCtrlId source fingerprint
-                chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {ctrlAsync = host, accepted}
-                _ <- waitCatch host
-                chatWriteVar remoteCtrlSession Nothing
-                toView $ CRRemoteCtrlStopped {remoteCtrlId}
-      chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {ctrlAsync = listener, accepted}
+      discoverer <- async $ discoverRemoteCtrls discovered
+      supervisor <- async $ do
+        remoteCtrlId <- atomically (readTMVar accepted)
+        withRemoteCtrl remoteCtrlId $ \RemoteCtrl {displayName, fingerprint} -> do
+          source <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure
+          toView $ CRRemoteCtrlConnecting {remoteCtrlId, displayName}
+          atomically $ writeTVar discovered mempty -- flush unused sources
+          server <- async $ Discovery.connectRevHTTP2 source fingerprint (processControllerRequest remoteCtrlId)
+          chatModifyVar remoteCtrlSession $ fmap $ \s -> s {hostServer = Just server}
+          toView $ CRRemoteCtrlConnected {remoteCtrlId, displayName}
+          _ <- waitCatch server
+          chatWriteVar remoteCtrlSession Nothing
+          toView $ CRRemoteCtrlStopped {remoteCtrlId}
+      chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted}
       pure CRRemoteCtrlStarted
 
-discoverRemoteCtrls :: (ChatMonad m) => TM.TMap RemoteCtrlId (TransportHost, C.KeyHash) -> m ()
+discoverRemoteCtrls :: (ChatMonad m) => TM.TMap C.KeyHash TransportHost -> m ()
 discoverRemoteCtrls discovered = Discovery.openListener >>= go
   where
     go sock =
@@ -155,47 +211,77 @@ discoverRemoteCtrls discovered = Discovery.openListener >>= go
         (SockAddrInet _port addr, invite) -> case strDecode invite of
           Left _ -> go sock -- ignore malformed datagrams
           Right fingerprint -> do
-            withStore' (\db -> getRemoteCtrlByFingerprint (DB.conn db) fingerprint) >>= \case
-              Nothing -> toView $ CRRemoteCtrlAnnounce fingerprint
-              Just found@RemoteCtrl {remoteCtrlId} -> do
-                atomically $ TM.insert remoteCtrlId (THIPv4 (hostAddressToTuple addr), fingerprint) discovered
-                toView $ CRRemoteCtrlFound found
+            atomically $ TM.insert fingerprint (THIPv4 $ hostAddressToTuple addr) discovered
+            withStore' (`getRemoteCtrlByFingerprint` fingerprint) >>= \case
+              Nothing -> toView $ CRRemoteCtrlAnnounce fingerprint -- unknown controller, ui action required
+              Just found@RemoteCtrl {remoteCtrlId, accepted=storedChoice} -> case storedChoice of
+                Nothing -> toView $ CRRemoteCtrlFound found -- first-time controller, ui action required
+                Just False -> pure () -- skipping a rejected item
+                Just True -> chatReadVar remoteCtrlSession >>= \case
+                  Nothing -> toView . CRChatError Nothing . ChatError $ CEInternalError "Remote host found without running a session"
+                  Just RemoteCtrlSession {accepted} -> atomically $ void $ tryPutTMVar accepted remoteCtrlId -- previously accepted controller, connect automatically
         _nonV4 -> go sock
 
-runRemoteHost :: (ChatMonad m) => RemoteCtrlId -> TransportHost -> C.KeyHash -> m ()
-runRemoteHost remoteCtrlId remoteCtrlHost fingerprint =
-  Discovery.connectSessionHost remoteCtrlHost fingerprint $ Discovery.attachServer (processControllerCommand remoteCtrlId)
+registerRemoteCtrl :: (ChatMonad m) => RemoteCtrlOOB -> m ChatResponse
+registerRemoteCtrl RemoteCtrlOOB {caFingerprint} = do
+  let displayName = "TODO" -- maybe include into OOB data
+  remoteCtrlId <- withStore' $ \db -> insertRemoteCtrl db displayName caFingerprint
+  pure $ CRRemoteCtrlRegistered {remoteCtrlId}
 
-confirmRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
-confirmRemoteCtrl remoteCtrlId =
+listRemoteCtrls :: (ChatMonad m) => m ChatResponse
+listRemoteCtrls = do
+  stored <- withStore' getRemoteCtrls
+  active <-
+    chatReadVar remoteCtrlSession >>= \case
+      Nothing -> pure Nothing
+      Just RemoteCtrlSession {accepted} -> atomically (tryReadTMVar accepted)
+  pure $ CRRemoteCtrlList $ do
+    RemoteCtrl {remoteCtrlId, displayName} <- stored
+    let sessionActive = active == Just remoteCtrlId
+    pure RemoteCtrlInfo {remoteCtrlId, displayName, sessionActive}
+
+acceptRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
+acceptRemoteCtrl remoteCtrlId = do
+  withStore' $ \db -> markRemoteCtrlResolution db remoteCtrlId True
   chatReadVar remoteCtrlSession >>= \case
     Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
-    Just RemoteCtrlSession {accepted} -> do
-      withStore' $ \db -> markRemoteCtrlResolution (DB.conn db) remoteCtrlId True
-      atomically $ putTMVar accepted remoteCtrlId -- the remote host can now proceed with connection
-      pure $ CRRemoteCtrlAccepted {remoteCtrlId}
+    Just RemoteCtrlSession {accepted} -> atomically . void $ tryPutTMVar accepted remoteCtrlId -- the remote host can now proceed with connection
+  pure $ CRRemoteCtrlAccepted {remoteCtrlId}
 
 rejectRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
-rejectRemoteCtrl remoteCtrlId =
+rejectRemoteCtrl remoteCtrlId = do
+  withStore' $ \db -> markRemoteCtrlResolution db remoteCtrlId False
   chatReadVar remoteCtrlSession >>= \case
     Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
-    Just RemoteCtrlSession {ctrlAsync} -> do
-      withStore' $ \db -> markRemoteCtrlResolution (DB.conn db) remoteCtrlId False
-      cancel ctrlAsync
-      pure $ CRRemoteCtrlRejected {remoteCtrlId}
+    Just RemoteCtrlSession {discoverer, supervisor} -> do
+      cancel discoverer
+      cancel supervisor
+  pure $ CRRemoteCtrlRejected {remoteCtrlId}
 
 stopRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
 stopRemoteCtrl remoteCtrlId =
   chatReadVar remoteCtrlSession >>= \case
     Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
-    Just RemoteCtrlSession {ctrlAsync} -> do
-      cancel ctrlAsync
-      pure CRRemoteCtrlStopped {remoteCtrlId}
+    Just RemoteCtrlSession {discoverer, supervisor, hostServer} -> do
+      cancel discoverer -- may be gone by now
+      case hostServer of
+        Just host -> cancel host -- supervisor will clean up
+        Nothing -> do
+          cancel supervisor -- supervisor is blocked until session progresses
+          chatWriteVar remoteCtrlSession Nothing
+          toView $ CRRemoteCtrlStopped {remoteCtrlId}
+      pure $ CRCmdOk Nothing
 
-disposeRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
-disposeRemoteCtrl remoteCtrlId =
+deleteRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
+deleteRemoteCtrl remoteCtrlId =
   chatReadVar remoteCtrlSession >>= \case
     Nothing -> do
-      withStore' $ \db -> deleteRemoteCtrl (DB.conn db) remoteCtrlId
-      pure $ CRRemoteCtrlDisposed {remoteCtrlId}
+      withStore' $ \db -> deleteRemoteCtrlRecord db remoteCtrlId
+      pure $ CRRemoteCtrlDeleted {remoteCtrlId}
     Just _ -> throwError $ ChatErrorRemoteCtrl RCEBusy
+
+withRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> (RemoteCtrl -> m a) -> m a
+withRemoteCtrl remoteCtrlId action =
+  withStore' (`getRemoteCtrl` remoteCtrlId) >>= \case
+    Nothing -> throwError $ ChatErrorRemoteCtrl RCEMissing {remoteCtrlId}
+    Just rc -> action rc
diff --git a/src/Simplex/Chat/Remote/Discovery.hs b/src/Simplex/Chat/Remote/Discovery.hs
index f04d0a008..2faed66cd 100644
--- a/src/Simplex/Chat/Remote/Discovery.hs
+++ b/src/Simplex/Chat/Remote/Discovery.hs
@@ -1,18 +1,21 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 
 module Simplex.Chat.Remote.Discovery
   ( -- * Announce
+    announceRevHTTP2,
     runAnnouncer,
+    startTLSServer,
+    runHTTP2Client,
 
     -- * Discovery
+    connectRevHTTP2,
     openListener,
     recvAnnounce,
-    connectSessionHost,
-    attachServer,
+    connectTLSClient,
+    attachHTTP2Server,
   )
 where
 
@@ -20,7 +23,6 @@ import Control.Monad
 import Data.ByteString (ByteString)
 import Data.Default (def)
 import Data.String (IsString)
-import Debug.Trace
 import qualified Network.Socket as N
 import qualified Network.TLS as TLS
 import qualified Network.UDP as UDP
@@ -33,54 +35,65 @@ import Simplex.Messaging.Transport.HTTP2 (defaultHTTP2BufferSize, getHTTP2Body)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError, attachHTTP2Client, defaultHTTP2ClientConfig)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..), runHTTP2ServerWith)
 import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTransportServer)
+import Simplex.Messaging.Util (whenM)
 import UnliftIO
 import UnliftIO.Concurrent
 
 -- | Link-local broadcast address.
 pattern BROADCAST_ADDR_V4 :: (IsString a, Eq a) => a
-pattern BROADCAST_ADDR_V4 = "255.255.255.255"
+pattern BROADCAST_ADDR_V4 = "0.0.0.0"
+
+pattern ANY_ADDR_V4 :: (IsString a, Eq a) => a
+pattern ANY_ADDR_V4 = "0.0.0.0"
 
 pattern BROADCAST_PORT :: (IsString a, Eq a) => a
 pattern BROADCAST_PORT = "5226"
 
-runAnnouncer :: (StrEncoding invite, MonadUnliftIO m) => IO () -> invite -> TLS.Credentials -> m (Either HTTP2ClientError HTTP2Client)
-runAnnouncer finished invite credentials = do
-  started <- newEmptyTMVarIO
-  aPid <- async $ announcer started (strEncode invite)
-  let serverParams =
-        def
-          { TLS.serverWantClientCert = False,
-            TLS.serverShared = def {TLS.sharedCredentials = credentials},
-            TLS.serverHooks = def,
-            TLS.serverSupported = supportedParameters
-          }
+-- | Announce tls server, wait for connection and attach http2 client to it.
+--
+-- Announcer is started when TLS server is started and stopped when a connection is made.
+announceRevHTTP2 :: (StrEncoding invite, MonadUnliftIO m) => IO () -> invite -> TLS.Credentials -> m (Either HTTP2ClientError HTTP2Client)
+announceRevHTTP2 finishAction invite credentials = do
   httpClient <- newEmptyMVar
-  liftIO $ runTransportServer started BROADCAST_PORT serverParams defaultTransportServerConfig (run aPid httpClient)
-  takeMVar httpClient
-  where
-    announcer started inviteBS = do
-      atomically (takeTMVar started) >>= \case
-        False ->
-          error "Server not started?.."
-        True -> liftIO $ do
-          traceM $ "TCP server started at " <> BROADCAST_PORT
-          sock <- UDP.clientSocket BROADCAST_ADDR_V4 BROADCAST_PORT False
-          N.setSocketOption (UDP.udpSocket sock) N.Broadcast 1
-          traceM $ "UDP announce started at " <> BROADCAST_ADDR_V4 <> ":" <> BROADCAST_PORT
-          traceM $ "Server invite: " <> show inviteBS
-          forever $ do
-            UDP.send sock inviteBS
-            threadDelay 1000000
+  started <- newEmptyTMVarIO
+  finished <- newEmptyMVar
+  announcer <- async . liftIO . whenM (atomically $ takeTMVar started) $ runAnnouncer (strEncode invite)
+  tlsServer <- startTLSServer started credentials $ \tls -> cancel announcer >> runHTTP2Client finished httpClient tls
+  _ <- forkIO . liftIO $ do
+    readMVar finished
+    cancel tlsServer
+    finishAction
+  readMVar httpClient
 
-    run :: Async () -> MVar (Either HTTP2ClientError HTTP2Client) -> Transport.TLS -> IO ()
-    run aPid clientVar tls = do
-      cancel aPid
-      let partyHost = "255.255.255.255" -- XXX: get from tls somehow? not required as host verification is disabled.
-      attachHTTP2Client defaultHTTP2ClientConfig partyHost BROADCAST_PORT finished defaultHTTP2BufferSize tls >>= putMVar clientVar
+-- | Broadcast invite with link-local datagrams
+runAnnouncer :: ByteString -> IO ()
+runAnnouncer inviteBS = do
+  sock <- UDP.clientSocket BROADCAST_ADDR_V4 BROADCAST_PORT False
+  N.setSocketOption (UDP.udpSocket sock) N.Broadcast 1
+  forever $ do
+    UDP.send sock inviteBS
+    threadDelay 1000000
+
+startTLSServer :: (MonadUnliftIO m) => TMVar Bool -> TLS.Credentials -> (Transport.TLS -> IO ()) -> m (Async ())
+startTLSServer started credentials = async . liftIO . runTransportServer started BROADCAST_PORT serverParams defaultTransportServerConfig
+  where
+    serverParams =
+      def
+        { TLS.serverWantClientCert = False,
+          TLS.serverShared = def {TLS.sharedCredentials = credentials},
+          TLS.serverHooks = def,
+          TLS.serverSupported = supportedParameters
+        }
+
+-- | Attach HTTP2 client and hold the TLS until the attached client finishes.
+runHTTP2Client :: MVar () -> MVar (Either HTTP2ClientError HTTP2Client) -> Transport.TLS -> IO ()
+runHTTP2Client finishedVar clientVar tls = do
+  attachHTTP2Client defaultHTTP2ClientConfig ANY_ADDR_V4 BROADCAST_PORT (putMVar finishedVar ()) defaultHTTP2BufferSize tls >>= putMVar clientVar
+  readMVar finishedVar
 
 openListener :: (MonadIO m) => m UDP.ListenSocket
 openListener = liftIO $ do
-  sock <- UDP.serverSocket (BROADCAST_ADDR_V4, read BROADCAST_PORT)
+  sock <- UDP.serverSocket (ANY_ADDR_V4, read BROADCAST_PORT)
   N.setSocketOption (UDP.listenSocket sock) N.Broadcast 1
   pure sock
 
@@ -89,11 +102,14 @@ recvAnnounce sock = liftIO $ do
   (invite, UDP.ClientSockAddr source _cmsg) <- UDP.recvFrom sock
   pure (source, invite)
 
-connectSessionHost :: (MonadUnliftIO m) => TransportHost -> C.KeyHash -> (Transport.TLS -> m a) -> m a
-connectSessionHost host caFingerprint = runTransportClient defaultTransportClientConfig Nothing host BROADCAST_PORT (Just caFingerprint)
+connectRevHTTP2 :: (MonadUnliftIO m) => TransportHost -> C.KeyHash -> (HTTP2Request -> m ()) -> m ()
+connectRevHTTP2 host fingerprint = connectTLSClient host fingerprint . attachHTTP2Server
 
-attachServer :: (MonadUnliftIO m) => (HTTP2Request -> m ()) -> Transport.TLS -> m ()
-attachServer processRequest tls = do
+connectTLSClient :: (MonadUnliftIO m) => TransportHost -> C.KeyHash -> (Transport.TLS -> m a) -> m a
+connectTLSClient host caFingerprint = runTransportClient defaultTransportClientConfig Nothing host BROADCAST_PORT (Just caFingerprint)
+
+attachHTTP2Server :: (MonadUnliftIO m) => (HTTP2Request -> m ()) -> Transport.TLS -> m ()
+attachHTTP2Server processRequest tls = do
   withRunInIO $ \unlift ->
     runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
       reqBody <- getHTTP2Body r defaultHTTP2BufferSize
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index 5902476fc..b66e9a625 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -6,26 +6,26 @@ module Simplex.Chat.Remote.Types where
 
 import Control.Concurrent.Async (Async)
 import Data.Aeson (ToJSON (..))
-import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.TMap (TMap)
+import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import UnliftIO.STM
-import Simplex.Messaging.Encoding.String (strToJEncoding, strToJSON)
 
 type RemoteHostId = Int64
 
 data RemoteHost = RemoteHost
   { remoteHostId :: RemoteHostId,
-    displayName :: Text,
-    -- | Path to store replicated files
     storePath :: FilePath,
-    -- | A stable part of X509 credentials used to access the host
-    caCert :: ByteString,
+    displayName :: Text,
     -- | Credentials signing key for root and session certs
-    caKey :: C.Key
+    caKey :: C.APrivateSignKey,
+    -- | A stable part of TLS credentials used in remote session
+    caCert :: C.SignedCertificate,
+    contacted :: Bool
   }
   deriving (Show)
 
@@ -39,19 +39,21 @@ data RemoteCtrl = RemoteCtrl
   }
   deriving (Show, Generic, ToJSON)
 
--- XXX: until fixed in master
-instance ToJSON C.KeyHash where
-  toEncoding = strToJEncoding
-  toJSON = strToJSON
-
-data RemoteHostSession = RemoteHostSession
-  { -- | Path for local resources to be synchronized with host
-    storePath :: FilePath,
-    ctrlClient :: HTTP2Client
-  }
+data RemoteHostSession
+  = RemoteHostSessionStarting
+      { announcer :: Async ()
+      }
+  | RemoteHostSessionStarted
+      { -- | Path for local resources to be synchronized with host
+        storePath :: FilePath,
+        ctrlClient :: HTTP2Client
+      }
 
 data RemoteCtrlSession = RemoteCtrlSession
   { -- | Server side of transport to process remote commands and forward notifications
-    ctrlAsync :: Async (),
+    discoverer :: Async (),
+    supervisor :: Async (),
+    hostServer :: Maybe (Async ()),
+    discovered :: TMap C.KeyHash TransportHost,
     accepted :: TMVar RemoteCtrlId
   }
diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs
index 591f346be..c231a535b 100644
--- a/src/Simplex/Chat/Store/Remote.hs
+++ b/src/Simplex/Chat/Store/Remote.hs
@@ -4,14 +4,20 @@
 
 module Simplex.Chat.Store.Remote where
 
-import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.Text (Text)
-import qualified Database.SQLite.Simple as DB
+import Database.SQLite.Simple (Only (..))
+import qualified Database.SQLite.Simple as SQL
+import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import Simplex.Chat.Remote.Types (RemoteCtrl (..), RemoteCtrlId, RemoteHost (..), RemoteHostId)
 import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow)
 import qualified Simplex.Messaging.Crypto as C
 
+insertRemoteHost :: DB.Connection -> FilePath -> Text -> C.APrivateSignKey -> C.SignedCertificate -> IO RemoteHostId
+insertRemoteHost db storePath displayName caKey caCert = do
+  DB.execute db "INSERT INTO remote_hosts (store_path, display_name, ca_key, ca_cert) VALUES (?,?,?,?)" (storePath, displayName, caKey, C.SignedObject caCert)
+  fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
+
 getRemoteHosts :: DB.Connection -> IO [RemoteHost]
 getRemoteHosts db =
   map toRemoteHost <$> DB.query_ db remoteHostQuery
@@ -19,14 +25,22 @@ getRemoteHosts db =
 getRemoteHost :: DB.Connection -> RemoteHostId -> IO (Maybe RemoteHost)
 getRemoteHost db remoteHostId =
   maybeFirstRow toRemoteHost $
-    DB.query db (remoteHostQuery <> "WHERE remote_host_id = ?") (DB.Only remoteHostId)
+    DB.query db (remoteHostQuery <> " WHERE remote_host_id = ?") (Only remoteHostId)
 
-remoteHostQuery :: DB.Query
-remoteHostQuery = "SELECT remote_host_id, display_name, store_path, ca_cert, ca_key FROM remote_hosts"
+remoteHostQuery :: SQL.Query
+remoteHostQuery = "SELECT remote_host_id, store_path, display_name, ca_key, ca_cert, contacted FROM remote_hosts"
 
-toRemoteHost :: (Int64, Text, FilePath, ByteString, C.Key) -> RemoteHost
-toRemoteHost (remoteHostId, displayName, storePath, caCert, caKey) =
-  RemoteHost {remoteHostId, displayName, storePath, caCert, caKey}
+toRemoteHost :: (Int64, FilePath, Text, C.APrivateSignKey, C.SignedObject C.Certificate, Bool) -> RemoteHost
+toRemoteHost (remoteHostId, storePath, displayName, caKey, C.SignedObject caCert, contacted) =
+  RemoteHost {remoteHostId, storePath, displayName, caKey, caCert, contacted}
+
+deleteRemoteHostRecord :: DB.Connection -> RemoteHostId -> IO ()
+deleteRemoteHostRecord db remoteHostId = DB.execute db "DELETE FROM remote_hosts WHERE remote_host_id = ?" (Only remoteHostId)
+
+insertRemoteCtrl :: DB.Connection -> Text -> C.KeyHash -> IO RemoteCtrlId
+insertRemoteCtrl db displayName fingerprint = do
+  DB.execute db "INSERT INTO remote_controllers (display_name, fingerprint) VALUES (?,?)" (displayName, fingerprint)
+  fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
 
 getRemoteCtrls :: DB.Connection -> IO [RemoteCtrl]
 getRemoteCtrls db =
@@ -35,14 +49,14 @@ getRemoteCtrls db =
 getRemoteCtrl :: DB.Connection -> RemoteCtrlId -> IO (Maybe RemoteCtrl)
 getRemoteCtrl db remoteCtrlId =
   maybeFirstRow toRemoteCtrl $
-    DB.query db (remoteCtrlQuery <> "WHERE remote_controller_id = ?") (DB.Only remoteCtrlId)
+    DB.query db (remoteCtrlQuery <> " WHERE remote_controller_id = ?") (Only remoteCtrlId)
 
 getRemoteCtrlByFingerprint :: DB.Connection -> C.KeyHash -> IO (Maybe RemoteCtrl)
 getRemoteCtrlByFingerprint db fingerprint =
   maybeFirstRow toRemoteCtrl $
-    DB.query db (remoteCtrlQuery <> "WHERE fingerprint = ?") (DB.Only fingerprint)
+    DB.query db (remoteCtrlQuery <> " WHERE fingerprint = ?") (Only fingerprint)
 
-remoteCtrlQuery :: DB.Query
+remoteCtrlQuery :: SQL.Query
 remoteCtrlQuery = "SELECT remote_controller_id, display_name, fingerprint, accepted FROM remote_controllers"
 
 toRemoteCtrl :: (Int64, Text, C.KeyHash, Maybe Bool) -> RemoteCtrl
@@ -53,6 +67,6 @@ markRemoteCtrlResolution :: DB.Connection -> RemoteCtrlId -> Bool -> IO ()
 markRemoteCtrlResolution db remoteCtrlId accepted =
   DB.execute db "UPDATE remote_controllers SET accepted = ? WHERE remote_controller_id = ? AND accepted IS NULL" (accepted, remoteCtrlId)
 
-deleteRemoteCtrl :: DB.Connection -> RemoteCtrlId -> IO ()
-deleteRemoteCtrl db remoteCtrlId =
-  DB.execute db "DELETE FROM remote_controllers WHERE remote_controller_id = ?" (DB.Only remoteCtrlId)
+deleteRemoteCtrlRecord :: DB.Connection -> RemoteCtrlId -> IO ()
+deleteRemoteCtrlRecord db remoteCtrlId =
+  DB.execute db "DELETE FROM remote_controllers WHERE remote_controller_id = ?" (Only remoteCtrlId)
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 9181351bd..42f8d70ff 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -4,10 +4,10 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 
 module Simplex.Chat.View where
 
@@ -42,6 +42,7 @@ import Simplex.Chat.Markdown
 import Simplex.Chat.Messages hiding (NewChatItem (..))
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Protocol
+import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store (AutoAccept (..), StoreError (..), UserContactLink (..))
 import Simplex.Chat.Styled
 import Simplex.Chat.Types
@@ -258,6 +259,23 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
   CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
   CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)]
   CRNtfMessages {} -> []
+  CRRemoteHostCreated rhId oobData -> ("remote host " <> sShow rhId <> " created") : viewRemoteCtrlOOBData oobData
+  CRRemoteHostList hs -> viewRemoteHosts hs
+  CRRemoteHostStarted rhId -> ["remote host " <> sShow rhId <> " started"]
+  CRRemoteHostConnected rhId -> ["remote host " <> sShow rhId <> " connected"]
+  CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
+  CRRemoteHostDeleted rhId -> ["remote host " <> sShow rhId <> " deleted"]
+  CRRemoteCtrlList cs -> viewRemoteCtrls cs
+  CRRemoteCtrlRegistered rcId -> ["remote controller " <> sShow rcId <> " registered"]
+  CRRemoteCtrlStarted -> ["remote controller started"]
+  CRRemoteCtrlAnnounce fingerprint -> ["remote controller announced", "connection code:", plain $ strEncode fingerprint]
+  CRRemoteCtrlFound rc -> ["remote controller found:", viewRemoteCtrl rc]
+  CRRemoteCtrlAccepted rcId -> ["remote controller " <> sShow rcId <> " accepted"]
+  CRRemoteCtrlRejected rcId -> ["remote controller " <> sShow rcId <> " rejected"]
+  CRRemoteCtrlConnecting rcId rcName -> ["remote controller " <> sShow rcId <> " connecting to " <> plain rcName]
+  CRRemoteCtrlConnected rcId rcName -> ["remote controller " <> sShow rcId <> " connected, " <> plain rcName]
+  CRRemoteCtrlStopped rcId -> ["remote controller " <> sShow rcId <> " stopped"]
+  CRRemoteCtrlDeleted rcId -> ["remote controller " <> sShow rcId <> " deleted"]
   CRSQLResult rows -> map plain rows
   CRSlowSQLQueries {chatQueries, agentQueries} ->
     let viewQuery SlowSQLQuery {query, queryStats = SlowQueryStats {count, timeMax, timeAvg}} =
@@ -298,7 +316,6 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
   CRChatError u e -> ttyUser' u $ viewChatError logLevel e
   CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)]
   CRTimedAction _ _ -> []
-  todo'cr -> ["TODO" <> sShow todo'cr]
   where
     ttyUser :: User -> [StyledString] -> [StyledString]
     ttyUser user@User {showNtfs, activeUser} ss
@@ -1539,6 +1556,31 @@ viewVersionInfo logLevel CoreVersionInfo {version, simplexmqVersion, simplexmqCo
   where
     parens s = " (" <> s <> ")"
 
+viewRemoteCtrlOOBData :: RemoteCtrlOOB -> [StyledString]
+viewRemoteCtrlOOBData RemoteCtrlOOB {caFingerprint} =
+  ["connection code:", plain $ strEncode caFingerprint]
+
+viewRemoteHosts :: [RemoteHostInfo] -> [StyledString]
+viewRemoteHosts = \case
+  [] -> ["No remote hosts"]
+  hs -> "Remote hosts: " : map viewRemoteHostInfo hs
+  where
+    viewRemoteHostInfo RemoteHostInfo {remoteHostId, displayName, sessionActive} =
+      plain $ tshow remoteHostId <> ". " <> displayName <> if sessionActive then " (active)" else ""
+
+viewRemoteCtrls :: [RemoteCtrlInfo] -> [StyledString]
+viewRemoteCtrls = \case
+  [] -> ["No remote controllers"]
+  hs -> "Remote controllers: " : map viewRemoteCtrlInfo hs
+  where
+    viewRemoteCtrlInfo RemoteCtrlInfo {remoteCtrlId, displayName, sessionActive} =
+      plain $ tshow remoteCtrlId <> ". " <> displayName <> if sessionActive then " (active)" else ""
+
+-- TODO fingerprint, accepted?
+viewRemoteCtrl :: RemoteCtrl -> StyledString
+viewRemoteCtrl RemoteCtrl {remoteCtrlId, displayName} =
+  plain $ tshow remoteCtrlId <> ". " <> displayName
+
 viewChatError :: ChatLogLevel -> ChatError -> [StyledString]
 viewChatError logLevel = \case
   ChatError err -> case err of
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
new file mode 100644
index 000000000..d1c162187
--- /dev/null
+++ b/tests/RemoteTests.hs
@@ -0,0 +1,148 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module RemoteTests where
+
+import ChatClient
+import ChatTests.Utils
+import Control.Monad
+import Data.List.NonEmpty (NonEmpty (..))
+import Debug.Trace
+import Network.HTTP.Types (ok200)
+import qualified Network.HTTP2.Client as C
+import qualified Network.HTTP2.Server as S
+import qualified Network.Socket as N
+import qualified Network.TLS as TLS
+import qualified Simplex.Chat.Remote.Discovery as Discovery
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
+import qualified Simplex.Messaging.Transport as Transport
+import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Response (..), closeHTTP2Client, sendRequest)
+import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
+import Test.Hspec
+import UnliftIO
+
+remoteTests :: SpecWith FilePath
+remoteTests = describe "Handshake" $ do
+  it "generates usable credentials" genCredentialsTest
+  it "connects announcer with discoverer over reverse-http2" announceDiscoverHttp2Test
+  it "connects desktop and mobile" remoteHandshakeTest
+
+-- * Low-level TLS with ephemeral credentials
+
+genCredentialsTest :: (HasCallStack) => FilePath -> IO ()
+genCredentialsTest _tmp = do
+  (fingerprint, credentials) <- genTestCredentials
+  started <- newEmptyTMVarIO
+  server <- Discovery.startTLSServer started credentials serverHandler
+  ok <- atomically (readTMVar started)
+  unless ok $ cancel server >> error "TLS server failed to start"
+  Discovery.connectTLSClient "127.0.0.1" fingerprint clientHandler
+  cancel server
+  where
+    serverHandler serverTls = do
+      traceM "    - Sending from server"
+      Transport.putLn serverTls "hi client"
+      traceM "    - Reading from server"
+      Transport.getLn serverTls `shouldReturn` "hi server"
+    clientHandler clientTls = do
+      traceM "    - Sending from client"
+      Transport.putLn clientTls "hi server"
+      traceM "    - Reading from client"
+      Transport.getLn clientTls `shouldReturn` "hi client"
+
+-- * UDP discovery and rever HTTP2
+
+announceDiscoverHttp2Test :: (HasCallStack) => FilePath -> IO ()
+announceDiscoverHttp2Test _tmp = do
+  (fingerprint, credentials) <- genTestCredentials
+  finished <- newEmptyMVar
+  announcer <- async $ do
+    traceM "    - Controller: starting"
+    http <- Discovery.announceRevHTTP2 (putMVar finished ()) fingerprint credentials >>= either (fail . show) pure
+    traceM "    - Controller: got client"
+    sendRequest http (C.requestNoBody "GET" "/" []) (Just 10000000) >>= \case
+      Left err -> do
+        traceM "    - Controller: got error"
+        fail $ show err
+      Right HTTP2Response {} ->
+        traceM "    - Controller: got response"
+    closeHTTP2Client http
+  dis <- async $ do
+    sock <- Discovery.openListener
+    (N.SockAddrInet _port addr, invite) <- Discovery.recvAnnounce sock
+    strDecode invite `shouldBe` Right fingerprint
+    traceM "    - Host: connecting"
+    server <- async $ Discovery.connectTLSClient (THIPv4 $ N.hostAddressToTuple addr) fingerprint $ \tls -> do
+      traceM "    - Host: got tls"
+      flip Discovery.attachHTTP2Server tls $ \HTTP2Request {sendResponse} -> do
+        traceM "    - Host: got request"
+        sendResponse $ S.responseNoBody ok200 []
+        traceM "    - Host: sent response"
+    takeMVar finished
+    cancel server
+    traceM "    - Host: finished"
+  waitBoth dis announcer `shouldReturn` ((), ())
+
+-- * Chat commands
+
+remoteHandshakeTest :: HasCallStack => FilePath -> IO ()
+remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
+  desktop ##> "/list remote hosts"
+  desktop <## "No remote hosts"
+  desktop ##> "/create remote host"
+  desktop <## "remote host 1 created"
+  desktop <## "connection code:"
+  fingerprint <- getTermLine desktop
+
+  desktop ##> "/list remote hosts"
+  desktop <## "Remote hosts:"
+  desktop <## "1. TODO" -- TODO host name probably should be Maybe, as when host is created there is no name yet
+
+  desktop ##> "/start remote host 1"
+  desktop <## "remote host 1 started"
+
+  mobile ##> "/start remote ctrl"
+  mobile <## "remote controller started"
+  mobile <## "remote controller announced"
+  mobile <## "connection code:"
+  fingerprint' <- getTermLine mobile
+  fingerprint' `shouldBe` fingerprint
+  mobile ##> "/list remote ctrls"
+  mobile <## "No remote controllers"
+  mobile ##> ("/register remote ctrl " <> fingerprint')
+  mobile <## "remote controller 1 registered"
+  mobile ##> "/list remote ctrls"
+  mobile <## "Remote controllers:"
+  mobile <## "1. TODO"
+  mobile ##> "/accept remote ctrl 1"
+  mobile <## "remote controller 1 accepted" -- alternative scenario: accepted before controller start
+  mobile <## "remote controller 1 connecting to TODO"
+  mobile <## "remote controller 1 connected, TODO"
+  mobile ##> "/stop remote ctrl 1"
+  mobile <## "ok"
+  mobile <## "remote controller 1 stopped" -- TODO two outputs
+  mobile ##> "/delete remote ctrl 1"
+  mobile <## "remote controller 1 deleted"
+  mobile ##> "/list remote ctrls"
+  mobile <## "No remote controllers"
+
+  desktop ##> "/stop remote host 1"
+  desktop <## "remote host 1 stopped"
+  desktop ##> "/delete remote host 1"
+  desktop <## "remote host 1 deleted"
+  desktop ##> "/list remote hosts"
+  desktop <## "No remote hosts"
+
+-- * Utils
+
+genTestCredentials :: IO (C.KeyHash, TLS.Credentials)
+genTestCredentials = do
+  caCreds <- liftIO $ genCredentials Nothing (0, 24) "CA"
+  sessionCreds <- liftIO $ genCredentials (Just caCreds) (0, 24) "Session"
+  pure . tlsCredentials $ sessionCreds :| [caCreds]
diff --git a/tests/Test.hs b/tests/Test.hs
index 455d5459c..d68de34aa 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -8,6 +8,7 @@ import Data.Time.Clock.System
 import MarkdownTests
 import MobileTests
 import ProtocolTests
+import RemoteTests
 import SchemaDump
 import Test.Hspec
 import UnliftIO.Temporary (withTempDirectory)
@@ -28,6 +29,7 @@ main = do
       describe "SimpleX chat client" chatTests
       xdescribe'' "SimpleX Broadcast bot" broadcastBotTests
       xdescribe'' "SimpleX Directory service bot" directoryServiceTests
+      describe "Remote session" remoteTests
   where
     testBracket test = do
       t <- getSystemTime

From fc9db9c38182e9b9fb2edae472be6d18ddfbc9e2 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Thu, 5 Oct 2023 21:49:20 +0300
Subject: [PATCH 07/69] core: add FromJSON instance to ChatResponse (#3129)

* Start adding FromJSON instances to ChatResponse

* progress

* FromJSON instance for ChatResponse compiles

* restore removed encodings

* remove comment

* diff

* update simplexmq, use TH for JSON

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 cabal.project                          |   2 +-
 scripts/nix/sha256map.nix              |   2 +-
 src/Simplex/Chat.hs                    |   8 +-
 src/Simplex/Chat/Call.hs               |  20 +-
 src/Simplex/Chat/Controller.hs         | 101 ++++++----
 src/Simplex/Chat/Markdown.hs           |  25 ++-
 src/Simplex/Chat/Messages.hs           | 243 +++++++++++++++++++++----
 src/Simplex/Chat/Messages/CIContent.hs | 110 +++++------
 src/Simplex/Chat/Protocol.hs           |   3 +
 src/Simplex/Chat/Remote.hs             |   2 +-
 src/Simplex/Chat/Remote/Types.hs       |   8 +-
 src/Simplex/Chat/Store/Profiles.hs     |   7 +-
 src/Simplex/Chat/Store/Shared.hs       |   5 +-
 src/Simplex/Chat/Types.hs              | 134 +++++++++-----
 src/Simplex/Chat/Types/Preferences.hs  |   7 +-
 src/Simplex/Chat/Types/Util.hs         |   3 +
 src/Simplex/Chat/View.hs               |  10 +-
 stack.yaml                             |   2 +-
 18 files changed, 483 insertions(+), 209 deletions(-)

diff --git a/cabal.project b/cabal.project
index f5bb87976..03b3bc810 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: 753a6c7542c3764fda9ce3f4c4cdc9f2329816d3
+    tag: 96a38505d63ec9a12096991e7725b250e397af72
 
 source-repository-package
     type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index b6ca36e31..748da0363 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."ec1b72cb8013a65a5d9783104a47ae44f5730089" = "1lz5rvgxp242zg95r9zd9j50y45314cf8nfpjg1qsa55nrk2w19b";
+  "https://github.com/simplex-chat/simplexmq.git"."96a38505d63ec9a12096991e7725b250e397af72" = "0kllakklvfrbpjlk6zi5mbxqm1prp6xdwyh2y4fw9n6c8b76is98";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "0kiwhvml42g9anw4d2v0zd1fpc790pj9syg5x3ik4l97fnkbbwpp";
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 29f69d99d..bcd23f44e 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -469,11 +469,11 @@ processChatCommand = \case
   DeleteUser uName delSMPQueues viewPwd_ -> withUserName uName $ \userId -> APIDeleteUser userId delSMPQueues viewPwd_
   StartChat subConns enableExpireCIs startXFTPWorkers -> withUser' $ \_ ->
     asks agentAsync >>= readTVarIO >>= \case
-      Just _ -> pure CRChatRunning
-      _ -> checkStoreNotChanged $ startChatController subConns enableExpireCIs startXFTPWorkers $> CRChatStarted
+      Just _ -> pure $ CRChatRunning Nothing
+      _ -> checkStoreNotChanged $ startChatController subConns enableExpireCIs startXFTPWorkers $> CRChatStarted Nothing
   APIStopChat -> do
     ask >>= stopChatController
-    pure CRChatStopped
+    pure $ CRChatStopped Nothing
   APIActivateChat -> withUser $ \_ -> do
     restoreCalls
     withAgent foregroundAgent
@@ -2814,7 +2814,7 @@ processAgentMessageNoConn = \case
   DISCONNECT p h -> hostEvent $ CRHostDisconnected p h
   DOWN srv conns -> serverEvent srv conns CRContactsDisconnected "disconnected"
   UP srv conns -> serverEvent srv conns CRContactsSubscribed "connected"
-  SUSPENDED -> toView CRChatSuspended
+  SUSPENDED -> toView $ CRChatSuspended Nothing
   DEL_USER agentUserId -> toView $ CRAgentUserDeleted agentUserId
   where
     hostEvent :: ChatResponse -> m ()
diff --git a/src/Simplex/Chat/Call.hs b/src/Simplex/Chat/Call.hs
index 7a738512b..7e6e60c8f 100644
--- a/src/Simplex/Chat/Call.hs
+++ b/src/Simplex/Chat/Call.hs
@@ -49,6 +49,9 @@ data CallStateTag
   | CSTCallNegotiated
   deriving (Show, Generic)
 
+instance FromJSON CallStateTag where
+  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CSTCall"
+
 instance ToJSON CallStateTag where
   toJSON = J.genericToJSON . enumJSON $ dropPrefix "CSTCall"
   toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CSTCall"
@@ -132,7 +135,7 @@ data RcvCallInvitation = RcvCallInvitation
     sharedKey :: Maybe C.Key,
     callTs :: UTCTime
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON RcvCallInvitation where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
@@ -157,10 +160,7 @@ data CallInvitation = CallInvitation
   { callType :: CallType,
     callDhPubKey :: Maybe C.PublicKeyX25519
   }
-  deriving (Eq, Show, Generic)
-
-instance FromJSON CallInvitation where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON CallInvitation where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
@@ -190,10 +190,7 @@ data CallOffer = CallOffer
     rtcSession :: WebRTCSession,
     callDhPubKey :: Maybe C.PublicKeyX25519
   }
-  deriving (Eq, Show, Generic)
-
-instance FromJSON CallOffer where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON CallOffer where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
@@ -203,10 +200,7 @@ data WebRTCCallOffer = WebRTCCallOffer
   { callType :: CallType,
     rtcSession :: WebRTCSession
   }
-  deriving (Eq, Show, Generic)
-
-instance FromJSON WebRTCCallOffer where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON WebRTCCallOffer where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index c6c813b74..986eaf073 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
@@ -12,6 +13,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Simplex.Chat.Controller where
 
@@ -24,11 +26,13 @@ import Control.Monad.Reader
 import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?))
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH  as JQ
 import qualified Data.Aeson.Types as JT
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (ord)
+import Data.Constraint (Dict (..))
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
@@ -64,7 +68,7 @@ import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
-import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType, CorrId, MsgFlags, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServerWithAuth)
+import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, MsgFlags, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServerWithAuth, userProtocol)
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -200,6 +204,9 @@ data ChatController = ChatController
 data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSIncognito | HSMarkdown | HSMessages | HSSettings | HSDatabase
   deriving (Show, Generic)
 
+instance FromJSON HelpSection where
+  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "HS"
+
 instance ToJSON HelpSection where
   toJSON = J.genericToJSON . enumJSON $ dropPrefix "HS"
   toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "HS"
@@ -438,10 +445,10 @@ data ChatCommand
 data ChatResponse
   = CRActiveUser {user :: User}
   | CRUsersList {users :: [UserInfo]}
-  | CRChatStarted
-  | CRChatRunning
-  | CRChatStopped
-  | CRChatSuspended
+  | CRChatStarted {_nullary :: Maybe Int}
+  | CRChatRunning {_nullary :: Maybe Int}
+  | CRChatStopped {_nullary :: Maybe Int}
+  | CRChatSuspended {_nullary :: Maybe Int}
   | CRApiChats {user :: User, chats :: [AChat]}
   | CRChats {chats :: [AChat]}
   | CRApiChat {user :: User, chat :: AChat}
@@ -605,7 +612,7 @@ data ChatResponse
   | CRRemoteHostDeleted {remoteHostId :: RemoteHostId}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlRegistered {remoteCtrlId :: RemoteCtrlId}
-  | CRRemoteCtrlStarted
+  | CRRemoteCtrlStarted {_nullary :: Maybe Int}
   | CRRemoteCtrlAnnounce {fingerprint :: C.KeyHash} -- unregistered fingerprint, needs confirmation
   | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrl} -- registered fingerprint, may connect
   | CRRemoteCtrlAccepted {remoteCtrlId :: RemoteCtrlId}
@@ -629,7 +636,7 @@ data ChatResponse
   | CRChatError {user_ :: Maybe User, chatError :: ChatError}
   | CRArchiveImported {archiveErrors :: [ArchiveError]}
   | CRTimedAction {action :: String, durationMilliseconds :: Int64}
-  deriving (Show, Generic)
+  deriving (Show)
 
 logResponseToFile :: ChatResponse -> Bool
 logResponseToFile = \case
@@ -650,17 +657,12 @@ logResponseToFile = \case
   CRMessageError {} -> True
   _ -> False
 
-instance FromJSON ChatResponse where
-  parseJSON todo = pure $ CRCmdOk Nothing -- TODO: actually use the instances
-
-instance ToJSON ChatResponse where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
-
 data RemoteCtrlOOB = RemoteCtrlOOB
   { caFingerprint :: C.KeyHash
   }
-  deriving (Show, Generic, ToJSON)
+  deriving (Show, Generic, FromJSON)
+
+instance ToJSON RemoteCtrlOOB where toEncoding = J.genericToEncoding J.defaultOptions
 
 data RemoteHostInfo = RemoteHostInfo
   { remoteHostId :: RemoteHostId,
@@ -668,14 +670,18 @@ data RemoteHostInfo = RemoteHostInfo
     displayName :: Text,
     sessionActive :: Bool
   }
-  deriving (Show, Generic, ToJSON)
+  deriving (Show, Generic, FromJSON)
+
+instance ToJSON RemoteHostInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
 data RemoteCtrlInfo = RemoteCtrlInfo
   { remoteCtrlId :: RemoteCtrlId,
     displayName :: Text,
     sessionActive :: Bool
   }
-  deriving (Eq, Show, Generic, ToJSON)
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON RemoteCtrlInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
 newtype UserPwd = UserPwd {unUserPwd :: Text}
   deriving (Eq, Show)
@@ -695,6 +701,9 @@ instance StrEncoding AgentQueueId where
   strDecode s = AgentQueueId <$> strDecode s
   strP = AgentQueueId <$> strP
 
+instance FromJSON AgentQueueId where
+  parseJSON = strParseJSON "AgentQueueId"
+
 instance ToJSON AgentQueueId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
@@ -713,12 +722,23 @@ data UserProtoServers p = UserProtoServers
   }
   deriving (Show, Generic)
 
+instance ProtocolTypeI p => FromJSON (UserProtoServers p) where
+  parseJSON = J.genericParseJSON J.defaultOptions
+
 instance ProtocolTypeI p => ToJSON (UserProtoServers p) where
-  toJSON = J.genericToJSON J.defaultOptions
   toEncoding = J.genericToEncoding J.defaultOptions
 
 data AUserProtoServers = forall p. (ProtocolTypeI p, UserProtocol p) => AUPS (UserProtoServers p)
 
+instance FromJSON AUserProtoServers where
+  parseJSON v = J.withObject "AUserProtoServers" parse v
+    where
+      parse o = do
+        AProtocolType (p :: SProtocolType p) <- o .: "serverProtocol"
+        case userProtocol p of
+          Just Dict -> AUPS <$> J.parseJSON @(UserProtoServers p) v
+          Nothing -> fail $ "AUserProtoServers: unsupported protocol " <> show p
+
 instance ToJSON AUserProtoServers where
   toJSON (AUPS s) = J.genericToJSON J.defaultOptions s
   toEncoding (AUPS s) = J.genericToEncoding J.defaultOptions s
@@ -747,7 +767,7 @@ data ContactSubStatus = ContactSubStatus
   { contact :: Contact,
     contactError :: Maybe ChatError
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON ContactSubStatus where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
@@ -757,7 +777,7 @@ data MemberSubStatus = MemberSubStatus
   { member :: GroupMember,
     memberError :: Maybe ChatError
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON MemberSubStatus where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
@@ -767,7 +787,7 @@ data UserContactSubStatus = UserContactSubStatus
   { userContact :: UserContact,
     userContactError :: Maybe ChatError
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON UserContactSubStatus where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
@@ -777,7 +797,7 @@ data PendingSubStatus = PendingSubStatus
   { connection :: PendingContactConnection,
     connError :: Maybe ChatError
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON PendingSubStatus where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
@@ -789,7 +809,7 @@ data UserProfileUpdateSummary = UserProfileUpdateSummary
     updateFailures :: Int,
     changedContacts :: [Contact]
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON UserProfileUpdateSummary where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -825,12 +845,10 @@ data XFTPFileConfig = XFTPFileConfig
 defaultXFTPFileConfig :: XFTPFileConfig
 defaultXFTPFileConfig = XFTPFileConfig {minFileSize = 0}
 
-instance ToJSON XFTPFileConfig where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+instance ToJSON XFTPFileConfig where toEncoding = J.genericToEncoding J.defaultOptions
 
 data NtfMsgInfo = NtfMsgInfo {msgTs :: UTCTime, msgFlags :: MsgFlags}
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON NtfMsgInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -842,7 +860,7 @@ data SwitchProgress = SwitchProgress
     switchPhase :: SwitchPhase,
     connectionStats :: ConnectionStats
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON SwitchProgress where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -850,7 +868,7 @@ data RatchetSyncProgress = RatchetSyncProgress
   { ratchetSyncStatus :: RatchetSyncState,
     connectionStats :: ConnectionStats
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON RatchetSyncProgress where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -858,7 +876,7 @@ data ParsedServerAddress = ParsedServerAddress
   { serverAddress :: Maybe ServerAddress,
     parseError :: String
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON ParsedServerAddress where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -869,7 +887,7 @@ data ServerAddress = ServerAddress
     keyHash :: String,
     basicAuth :: String
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON ServerAddress where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -893,7 +911,7 @@ data CoreVersionInfo = CoreVersionInfo
     simplexmqVersion :: String,
     simplexmqCommit :: String
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON CoreVersionInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -906,7 +924,7 @@ data SlowSQLQuery = SlowSQLQuery
   { query :: Text,
     queryStats :: SlowQueryStats
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON SlowSQLQuery where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -919,6 +937,9 @@ data ChatError
   | ChatErrorRemoteHost {remoteHostId :: RemoteHostId, remoteHostError :: RemoteHostError}
   deriving (Show, Exception, Generic)
 
+instance FromJSON ChatError where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "Chat"
+
 instance ToJSON ChatError where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "Chat"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "Chat"
@@ -1002,6 +1023,9 @@ data ChatErrorType
   | CEException {message :: String}
   deriving (Show, Exception, Generic)
 
+instance FromJSON ChatErrorType where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CE"
+
 instance ToJSON ChatErrorType where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CE"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CE"
@@ -1014,6 +1038,9 @@ data DatabaseError
   | DBErrorOpen {sqliteError :: SQLiteError}
   deriving (Show, Exception, Generic)
 
+instance FromJSON DatabaseError where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "DB"
+
 instance ToJSON DatabaseError where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "DB"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "DB"
@@ -1021,6 +1048,9 @@ instance ToJSON DatabaseError where
 data SQLiteError = SQLiteErrorNotADatabase | SQLiteError String
   deriving (Show, Exception, Generic)
 
+instance FromJSON SQLiteError where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SQLite"
+
 instance ToJSON SQLiteError where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SQLite"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SQLite"
@@ -1070,6 +1100,9 @@ data ArchiveError
   | AEImportFile {file :: String, chatError :: ChatError}
   deriving (Show, Exception, Generic)
 
+instance FromJSON ArchiveError where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "AE"
+
 instance ToJSON ArchiveError where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "AE"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "AE"
@@ -1156,3 +1189,5 @@ withStoreCtx ctx_ action = do
   where
     handleInternal :: String -> SomeException -> IO (Either StoreError a)
     handleInternal ctxStr e = pure . Left . SEInternalError $ show e <> ctxStr
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CR") ''ChatResponse)
diff --git a/src/Simplex/Chat/Markdown.hs b/src/Simplex/Chat/Markdown.hs
index d18f28db3..64b114553 100644
--- a/src/Simplex/Chat/Markdown.hs
+++ b/src/Simplex/Chat/Markdown.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -10,7 +11,7 @@
 module Simplex.Chat.Markdown where
 
 import Control.Applicative (optional, (<|>))
-import Data.Aeson (ToJSON)
+import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
 import Data.Attoparsec.Text (Parser)
 import qualified Data.Attoparsec.Text as A
@@ -56,6 +57,9 @@ data Format
 data SimplexLinkType = XLContact | XLInvitation | XLGroup
   deriving (Eq, Show, Generic)
 
+instance FromJSON SimplexLinkType where
+  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "XL"
+
 instance ToJSON SimplexLinkType where
   toJSON = J.genericToJSON . enumJSON $ dropPrefix "XL"
   toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "XL"
@@ -66,6 +70,9 @@ colored = Colored . FormatColor
 markdown :: Format -> Text -> Markdown
 markdown = Markdown . Just
 
+instance FromJSON Format where
+  parseJSON = J.genericParseJSON $ sumTypeJSON fstToLower
+
 instance ToJSON Format where
   toJSON = J.genericToJSON $ sumTypeJSON fstToLower
   toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
@@ -91,6 +98,18 @@ instance IsString Markdown where fromString = unmarked . T.pack
 newtype FormatColor = FormatColor Color
   deriving (Eq, Show)
 
+instance FromJSON FormatColor where
+  parseJSON = J.withText "FormatColor" $ fmap FormatColor . \case
+    "red" -> pure Red
+    "green" -> pure Green
+    "blue" -> pure Blue
+    "yellow" -> pure Yellow
+    "cyan" -> pure Cyan
+    "magenta" -> pure Magenta
+    "black" -> pure Black
+    "white" -> pure White
+    unexpected -> fail $ "unexpected FormatColor: " <> show unexpected
+
 instance ToJSON FormatColor where
   toJSON (FormatColor c) = case c of
     Red -> "red"
@@ -103,7 +122,7 @@ instance ToJSON FormatColor where
     White -> "white"
 
 data FormattedText = FormattedText {format :: Maybe Format, text :: Text}
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON FormattedText where
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
@@ -129,7 +148,7 @@ parseMaybeMarkdownList s
   | otherwise = Just . reverse $ foldl' acc [] ml
   where
     ml = intercalate ["\n"] . map (markdownToList . parseMarkdown) $ T.lines s
-    acc [] m = [m] 
+    acc [] m = [m]
     acc ms@(FormattedText f t : ms') ft@(FormattedText f' t')
       | f == f' = FormattedText f (t <> t') : ms'
       | otherwise = ft : ms
diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs
index 79463d210..b9ce95373 100644
--- a/src/Simplex/Chat/Messages.hs
+++ b/src/Simplex/Chat/Messages.hs
@@ -17,7 +17,7 @@
 module Simplex.Chat.Messages where
 
 import Control.Applicative ((<|>))
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON, ToJSON, (.:))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -66,6 +66,9 @@ chatNameStr (ChatName cType name) = chatTypeStr cType <> T.unpack name
 data ChatRef = ChatRef ChatType Int64
   deriving (Eq, Show, Ord)
 
+instance FromJSON ChatType where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CT"
+
 instance ToJSON ChatType where
   toJSON = J.genericToJSON . enumJSON $ dropPrefix "CT"
   toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CT"
@@ -110,10 +113,16 @@ data JSONChatInfo
   | JCInfoContactConnection {contactConnection :: PendingContactConnection}
   deriving (Generic)
 
+instance FromJSON JSONChatInfo where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCInfo"
+
 instance ToJSON JSONChatInfo where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCInfo"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCInfo"
 
+instance ChatTypeI c => FromJSON (ChatInfo c) where
+  parseJSON v = (\(AChatInfo _ c) -> checkChatType c) <$?> J.parseJSON v
+
 instance ToJSON (ChatInfo c) where
   toJSON = J.toJSON . jsonChatInfo
   toEncoding = J.toEncoding . jsonChatInfo
@@ -125,10 +134,20 @@ jsonChatInfo = \case
   ContactRequest g -> JCInfoContactRequest g
   ContactConnection c -> JCInfoContactConnection c
 
-data AChatInfo = forall c. AChatInfo (SChatType c) (ChatInfo c)
+data AChatInfo = forall c. ChatTypeI c => AChatInfo (SChatType c) (ChatInfo c)
 
 deriving instance Show AChatInfo
 
+jsonAChatInfo :: JSONChatInfo -> AChatInfo
+jsonAChatInfo = \case
+  JCInfoDirect c -> AChatInfo SCTDirect $ DirectChat c
+  JCInfoGroup g -> AChatInfo SCTGroup $ GroupChat g
+  JCInfoContactRequest g -> AChatInfo SCTContactRequest $ ContactRequest g
+  JCInfoContactConnection c -> AChatInfo SCTContactConnection $ ContactConnection c
+
+instance FromJSON AChatInfo where
+  parseJSON v = jsonAChatInfo <$> J.parseJSON v
+
 instance ToJSON AChatInfo where
   toJSON (AChatInfo _ c) = J.toJSON c
   toEncoding (AChatInfo _ c) = J.toEncoding c
@@ -144,7 +163,10 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
   }
   deriving (Show, Generic)
 
-instance MsgDirectionI d => ToJSON (ChatItem c d) where
+instance (ChatTypeI c, MsgDirectionI d) => FromJSON (ChatItem c d) where
+  parseJSON = J.genericParseJSON J.defaultOptions
+
+instance (ChatTypeI c, MsgDirectionI d) => ToJSON (ChatItem c d) where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
@@ -156,6 +178,16 @@ data CIDirection (c :: ChatType) (d :: MsgDirection) where
 
 deriving instance Show (CIDirection c d)
 
+data CCIDirection c = forall d. MsgDirectionI d => CCID (SMsgDirection d) (CIDirection c d)
+
+instance ChatTypeI c => FromJSON (CCIDirection c) where
+  parseJSON v = (\(ACID _ d x) -> checkChatType (CCID d x)) <$?> J.parseJSON v
+
+data ACIDirection = forall c d. (ChatTypeI c, MsgDirectionI d) => ACID (SChatType c) (SMsgDirection d) (CIDirection c d)
+
+instance FromJSON ACIDirection where
+  parseJSON v = jsonACIDirection <$> J.parseJSON v
+
 data JSONCIDirection
   = JCIDirectSnd
   | JCIDirectRcv
@@ -163,10 +195,16 @@ data JSONCIDirection
   | JCIGroupRcv {groupMember :: GroupMember}
   deriving (Generic, Show)
 
+instance FromJSON JSONCIDirection where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCI"
+
 instance ToJSON JSONCIDirection where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCI"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCI"
 
+instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIDirection c d) where
+  parseJSON v = (\(CCID _ x') -> checkDirection x') <$?> J.parseJSON v
+
 instance ToJSON (CIDirection c d) where
   toJSON = J.toJSON . jsonCIDirection
   toEncoding = J.toEncoding . jsonCIDirection
@@ -178,8 +216,15 @@ jsonCIDirection = \case
   CIGroupSnd -> JCIGroupSnd
   CIGroupRcv m -> JCIGroupRcv m
 
+jsonACIDirection :: JSONCIDirection -> ACIDirection
+jsonACIDirection = \case
+  JCIDirectSnd -> ACID SCTDirect SMDSnd CIDirectSnd
+  JCIDirectRcv -> ACID SCTDirect SMDRcv CIDirectRcv
+  JCIGroupSnd -> ACID SCTGroup SMDSnd CIGroupSnd
+  JCIGroupRcv m -> ACID SCTGroup SMDRcv $ CIGroupRcv m
+
 data CIReactionCount = CIReactionCount {reaction :: MsgReaction, userReacted :: Bool, totalReacted :: Int}
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON CIReactionCount where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -187,7 +232,15 @@ data CChatItem c = forall d. MsgDirectionI d => CChatItem (SMsgDirection d) (Cha
 
 deriving instance Show (CChatItem c)
 
-instance ToJSON (CChatItem c) where
+instance forall c. ChatTypeI c => FromJSON (CChatItem c) where
+  parseJSON v = J.withObject "CChatItem" parse v
+    where
+      parse o = do
+        CCID d (_ :: CIDirection c d) <- o .: "chatDir"
+        ci <- J.parseJSON @(ChatItem c d) v
+        pure $ CChatItem d ci
+
+instance ChatTypeI c => ToJSON (CChatItem c) where
   toJSON (CChatItem _ ci) = J.toJSON ci
   toEncoding (CChatItem _ ci) = J.toEncoding ci
 
@@ -279,14 +332,19 @@ data Chat c = Chat
   }
   deriving (Show, Generic)
 
-instance ToJSON (Chat c) where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+instance ChatTypeI c => ToJSON (Chat c) where toEncoding = J.genericToEncoding J.defaultOptions
 
-data AChat = forall c. AChat (SChatType c) (Chat c)
+data AChat = forall c. ChatTypeI c => AChat (SChatType c) (Chat c)
 
 deriving instance Show AChat
 
+instance FromJSON AChat where
+  parseJSON = J.withObject "AChat" $ \o -> do
+    AChatInfo c chatInfo <- o .: "chatInfo"
+    chatItems <- o .: "chatItems"
+    chatStats <- o .: "chatStats"
+    pure $ AChat c Chat {chatInfo, chatItems, chatStats}
+
 instance ToJSON AChat where
   toJSON (AChat _ c) = J.toJSON c
   toEncoding (AChat _ c) = J.toEncoding c
@@ -296,17 +354,21 @@ data ChatStats = ChatStats
     minUnreadItemId :: ChatItemId,
     unreadChat :: Bool
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
-instance ToJSON ChatStats where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+instance ToJSON ChatStats where toEncoding = J.genericToEncoding J.defaultOptions
 
 -- | type to show a mix of messages from multiple chats
-data AChatItem = forall c d. MsgDirectionI d => AChatItem (SChatType c) (SMsgDirection d) (ChatInfo c) (ChatItem c d)
+data AChatItem = forall c d. (ChatTypeI c, MsgDirectionI d) => AChatItem (SChatType c) (SMsgDirection d) (ChatInfo c) (ChatItem c d)
 
 deriving instance Show AChatItem
 
+instance FromJSON AChatItem where
+  parseJSON = J.withObject "AChatItem" $ \o -> do
+    AChatInfo c chatInfo <- o .: "chatInfo"
+    CChatItem d chatItem <- o .: "chatItem"
+    pure $ AChatItem c d chatInfo chatItem
+
 instance ToJSON AChatItem where
   toJSON (AChatItem _ _ chat item) = J.toJSON $ JSONAnyChatItem chat item
   toEncoding (AChatItem _ _ chat item) = J.toEncoding $ JSONAnyChatItem chat item
@@ -330,7 +392,7 @@ updateFileStatus ci@ChatItem {file} status = case file of
   Just f -> ci {file = Just (f :: CIFile d) {fileStatus = status}}
   Nothing -> ci
 
-instance MsgDirectionI d => ToJSON (JSONAnyChatItem c d) where
+instance (ChatTypeI c, MsgDirectionI d) => ToJSON (JSONAnyChatItem c d) where
   toJSON = J.genericToJSON J.defaultOptions
   toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -349,7 +411,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
     createdAt :: UTCTime,
     updatedAt :: UTCTime
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> CIMeta c d
 mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs createdAt updatedAt =
@@ -358,13 +420,13 @@ mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted item
         _ -> False
    in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, createdAt, updatedAt}
 
-instance ToJSON (CIMeta c d) where toEncoding = J.genericToEncoding J.defaultOptions
+instance ChatTypeI c => ToJSON (CIMeta c d) where toEncoding = J.genericToEncoding J.defaultOptions
 
 data CITimed = CITimed
   { ttl :: Int, -- seconds
     deleteAt :: Maybe UTCTime -- this is initially Nothing for received items, the timer starts when they are read
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON CITimed where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -402,6 +464,9 @@ data CIQuote (c :: ChatType) = CIQuote
   }
   deriving (Show, Generic)
 
+instance ChatTypeI c => FromJSON (CIQuote c) where
+  parseJSON = J.genericParseJSON J.defaultOptions
+
 instance ToJSON (CIQuote c) where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
@@ -414,24 +479,39 @@ data CIReaction (c :: ChatType) (d :: MsgDirection) = CIReaction
   }
   deriving (Show, Generic)
 
-instance ToJSON (CIReaction c d) where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIReaction c d) where
+  parseJSON = J.genericParseJSON J.defaultOptions
 
-data ACIReaction = forall c d. ACIReaction (SChatType c) (SMsgDirection d) (ChatInfo c) (CIReaction c d)
+instance ChatTypeI c => ToJSON (CIReaction c d) where
+  toEncoding = J.genericToEncoding J.defaultOptions
+
+data AnyCIReaction = forall c d. ChatTypeI c => ACIR (SChatType c) (SMsgDirection d) (CIReaction c d)
+
+instance FromJSON AnyCIReaction where
+  parseJSON v = J.withObject "AnyCIReaction" parse v
+    where
+      parse o = do
+        ACID c d (_ :: CIDirection c d) <- o .: "chatDir"
+        ACIR c d <$> J.parseJSON @(CIReaction c d) v
+
+data ACIReaction = forall c d. ChatTypeI c => ACIReaction (SChatType c) (SMsgDirection d) (ChatInfo c) (CIReaction c d)
 
 deriving instance Show ACIReaction
 
+instance FromJSON ACIReaction where
+  parseJSON = J.withObject "ACIReaction" $ \o -> do
+    ACIR c d reaction <- o .: "chatReaction"
+    cInfo <- o .: "chatInfo"
+    pure $ ACIReaction c d cInfo reaction
+
 instance ToJSON ACIReaction where
-  toJSON (ACIReaction _ _ chat reaction) = J.toJSON $ JSONCIReaction chat reaction
-  toEncoding (ACIReaction _ _ chat reaction) = J.toEncoding $ JSONCIReaction chat reaction
+  toJSON (ACIReaction _ _ cInfo reaction) = J.toJSON $ JSONCIReaction cInfo reaction
+  toEncoding (ACIReaction _ _ cInfo reaction) = J.toEncoding $ JSONCIReaction cInfo reaction
 
 data JSONCIReaction c d = JSONCIReaction {chatInfo :: ChatInfo c, chatReaction :: CIReaction c d}
   deriving (Generic)
 
-instance ToJSON (JSONCIReaction c d) where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+instance ChatTypeI c => ToJSON (JSONCIReaction c d) where toEncoding = J.genericToEncoding J.defaultOptions
 
 data CIQDirection (c :: ChatType) where
   CIQDirectSnd :: CIQDirection 'CTDirect
@@ -441,6 +521,11 @@ data CIQDirection (c :: ChatType) where
 
 deriving instance Show (CIQDirection c)
 
+data ACIQDirection = forall c. ChatTypeI c => ACIQDirection (SChatType c) (CIQDirection c)
+
+instance ChatTypeI c => FromJSON (CIQDirection c) where
+  parseJSON v = (\(ACIQDirection _ x) -> checkChatType x) . jsonACIQDirection <$?> J.parseJSON v
+
 instance ToJSON (CIQDirection c) where
   toJSON = J.toJSON . jsonCIQDirection
   toEncoding = J.toEncoding . jsonCIQDirection
@@ -453,6 +538,14 @@ jsonCIQDirection = \case
   CIQGroupRcv (Just m) -> Just $ JCIGroupRcv m
   CIQGroupRcv Nothing -> Nothing
 
+jsonACIQDirection :: Maybe JSONCIDirection -> ACIQDirection
+jsonACIQDirection = \case
+  Just JCIDirectSnd -> ACIQDirection SCTDirect CIQDirectSnd
+  Just JCIDirectRcv -> ACIQDirection SCTDirect CIQDirectRcv
+  Just JCIGroupSnd -> ACIQDirection SCTGroup CIQGroupSnd
+  Just (JCIGroupRcv m) -> ACIQDirection SCTGroup $ CIQGroupRcv (Just m)
+  Nothing -> ACIQDirection SCTGroup $ CIQGroupRcv Nothing
+
 quoteMsgDirection :: CIQDirection c -> MsgDirection
 quoteMsgDirection = \case
   CIQDirectSnd -> MDSnd
@@ -470,6 +563,9 @@ data CIFile (d :: MsgDirection) = CIFile
   }
   deriving (Show, Generic)
 
+instance MsgDirectionI d => FromJSON (CIFile d) where
+  parseJSON = J.genericParseJSON J.defaultOptions
+
 instance MsgDirectionI d => ToJSON (CIFile d) where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
@@ -481,6 +577,9 @@ instance FromField FileProtocol where fromField = fromTextField_ textDecode
 
 instance ToField FileProtocol where toField = toField . textEncode
 
+instance FromJSON FileProtocol where
+  parseJSON = textParseJSON "FileProtocol"
+
 instance ToJSON FileProtocol where
   toJSON = J.String . textEncode
   toEncoding = JE.text . textEncode
@@ -527,6 +626,9 @@ ciFileEnded = \case
   CIFSRcvError -> True
   CIFSInvalid {} -> True
 
+instance MsgDirectionI d => FromJSON (CIFileStatus d) where
+  parseJSON v = (\(AFS _ s) -> checkDirection s) . aciFileStatusJSON <$?> J.parseJSON v
+
 instance ToJSON (CIFileStatus d) where
   toJSON = J.toJSON . jsonCIFileStatus
   toEncoding = J.toEncoding . jsonCIFileStatus
@@ -594,6 +696,9 @@ data JSONCIFileStatus
   | JCIFSInvalid {text :: Text}
   deriving (Generic)
 
+instance FromJSON JSONCIFileStatus where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCIFS"
+
 instance ToJSON JSONCIFileStatus where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIFS"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIFS"
@@ -658,6 +763,9 @@ deriving instance Eq (CIStatus d)
 
 deriving instance Show (CIStatus d)
 
+instance MsgDirectionI d => FromJSON (CIStatus d) where
+  parseJSON v = (\(ACIStatus _ s) -> checkDirection s) . jsonACIStatus <$?> J.parseJSON v
+
 instance ToJSON (CIStatus d) where
   toJSON = J.toJSON . jsonCIStatus
   toEncoding = J.toEncoding . jsonCIStatus
@@ -712,6 +820,9 @@ data JSONCIStatus
   | JCISInvalid {text :: Text}
   deriving (Show, Generic)
 
+instance FromJSON JSONCIStatus where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCIS"
+
 instance ToJSON JSONCIStatus where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIS"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIS"
@@ -727,6 +838,17 @@ jsonCIStatus = \case
   CISRcvRead -> JCISRcvRead
   CISInvalid text -> JCISInvalid text
 
+jsonACIStatus :: JSONCIStatus -> ACIStatus
+jsonACIStatus = \case
+  JCISSndNew -> ACIStatus SMDSnd CISSndNew
+  JCISSndSent sndProgress -> ACIStatus SMDSnd $ CISSndSent sndProgress
+  JCISSndRcvd msgRcptStatus sndProgress -> ACIStatus SMDSnd $ CISSndRcvd msgRcptStatus sndProgress
+  JCISSndErrorAuth -> ACIStatus SMDSnd CISSndErrorAuth
+  JCISSndError e -> ACIStatus SMDSnd $ CISSndError e
+  JCISRcvNew -> ACIStatus SMDRcv CISRcvNew
+  JCISRcvRead -> ACIStatus SMDRcv CISRcvRead
+  JCISInvalid text -> ACIStatus SMDSnd $ CISInvalid text
+
 ciStatusNew :: forall d. MsgDirectionI d => CIStatus d
 ciStatusNew = case msgDirection @d of
   SMDSnd -> CISSndNew
@@ -757,6 +879,9 @@ data SndCIStatusProgress
   | SSPComplete
   deriving (Eq, Show, Generic)
 
+instance FromJSON SndCIStatusProgress where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SSP"
+
 instance ToJSON SndCIStatusProgress where
   toJSON = J.genericToJSON . enumJSON $ dropPrefix "SSP"
   toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "SSP"
@@ -796,6 +921,8 @@ instance TestEquality SChatType where
   testEquality SCTContactConnection SCTContactConnection = Just Refl
   testEquality _ _ = Nothing
 
+data AChatType = forall c. ChatTypeI c => ACT (SChatType c)
+
 class ChatTypeI (c :: ChatType) where
   chatTypeI :: SChatType c
 
@@ -803,6 +930,36 @@ instance ChatTypeI 'CTDirect where chatTypeI = SCTDirect
 
 instance ChatTypeI 'CTGroup where chatTypeI = SCTGroup
 
+instance ChatTypeI 'CTContactRequest where chatTypeI = SCTContactRequest
+
+instance ChatTypeI 'CTContactConnection where chatTypeI = SCTContactConnection
+
+instance ChatTypeI c => FromJSON (SChatType c) where
+  parseJSON v = (\(ACT t) -> checkChatType t) . aChatType <$?> J.parseJSON v
+
+instance ToJSON (SChatType c) where
+  toJSON = J.toJSON . toChatType
+  toEncoding = J.toEncoding . toChatType
+
+toChatType :: SChatType c -> ChatType
+toChatType = \case
+  SCTDirect -> CTDirect
+  SCTGroup -> CTGroup
+  SCTContactRequest -> CTContactRequest
+  SCTContactConnection -> CTContactConnection
+
+aChatType :: ChatType -> AChatType
+aChatType = \case
+  CTDirect -> ACT SCTDirect
+  CTGroup -> ACT SCTGroup
+  CTContactRequest -> ACT SCTContactRequest
+  CTContactConnection -> ACT SCTContactConnection
+
+checkChatType :: forall t c c'. (ChatTypeI c, ChatTypeI c') => t c' -> Either String (t c)
+checkChatType x = case testEquality (chatTypeI @c) (chatTypeI @c') of
+  Just Refl -> Right x
+  Nothing -> Left "bad chat type"
+
 data NewMessage e = NewMessage
   { chatMsgEvent :: ChatMsgEvent e,
     msgBody :: MsgBody
@@ -920,35 +1077,43 @@ msgDeliveryStatusT' s =
       Just Refl -> Just st
       _ -> Nothing
 
-checkDirection :: forall t d d'. (MsgDirectionI d, MsgDirectionI d') => t d' -> Either String (t d)
-checkDirection x = case testEquality (msgDirection @d) (msgDirection @d') of
-  Just Refl -> Right x
-  Nothing -> Left "bad direction"
-
 data CIDeleted (c :: ChatType) where
   CIDeleted :: Maybe UTCTime -> CIDeleted c
   CIModerated :: Maybe UTCTime -> GroupMember -> CIDeleted 'CTGroup
 
 deriving instance Show (CIDeleted c)
 
-instance ToJSON (CIDeleted d) where
+data ACIDeleted = forall c. ChatTypeI c => ACIDeleted (SChatType c) (CIDeleted c)
+
+instance ChatTypeI c => FromJSON (CIDeleted c) where
+  parseJSON v = (\(ACIDeleted _ x) -> checkChatType x) . jsonACIDeleted <$?> J.parseJSON v
+
+instance ChatTypeI c => ToJSON (CIDeleted c) where
   toJSON = J.toJSON . jsonCIDeleted
   toEncoding = J.toEncoding . jsonCIDeleted
 
 data JSONCIDeleted
-  = JCIDDeleted {deletedTs :: Maybe UTCTime}
+  = JCIDDeleted {deletedTs :: Maybe UTCTime, chatType :: ChatType}
   | JCIDModerated {deletedTs :: Maybe UTCTime, byGroupMember :: GroupMember}
   deriving (Show, Generic)
 
+instance FromJSON JSONCIDeleted where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCID"
+
 instance ToJSON JSONCIDeleted where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCID"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCID"
 
-jsonCIDeleted :: CIDeleted d -> JSONCIDeleted
+jsonCIDeleted :: forall d. ChatTypeI d => CIDeleted d -> JSONCIDeleted
 jsonCIDeleted = \case
-  CIDeleted ts -> JCIDDeleted ts
+  CIDeleted ts -> JCIDDeleted ts (toChatType $ chatTypeI @d)
   CIModerated ts m -> JCIDModerated ts m
 
+jsonACIDeleted :: JSONCIDeleted -> ACIDeleted
+jsonACIDeleted = \case
+  JCIDDeleted ts cType -> case aChatType cType of ACT c -> ACIDeleted c $ CIDeleted ts
+  JCIDModerated ts m -> ACIDeleted SCTGroup (CIModerated ts m)
+
 itemDeletedTs :: CIDeleted d -> Maybe UTCTime
 itemDeletedTs = \case
   CIDeleted ts -> ts
@@ -958,7 +1123,7 @@ data ChatItemInfo = ChatItemInfo
   { itemVersions :: [ChatItemVersion],
     memberDeliveryStatuses :: Maybe [MemberDeliveryStatus]
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON ChatItemInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -969,7 +1134,7 @@ data ChatItemVersion = ChatItemVersion
     itemVersionTs :: UTCTime,
     createdAt :: UTCTime
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON ChatItemVersion where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -990,7 +1155,7 @@ data MemberDeliveryStatus = MemberDeliveryStatus
   { groupMemberId :: GroupMemberId,
     memberDeliveryStatus :: CIStatus 'MDSnd
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON MemberDeliveryStatus where toEncoding = J.genericToEncoding J.defaultOptions
 
diff --git a/src/Simplex/Chat/Messages/CIContent.hs b/src/Simplex/Chat/Messages/CIContent.hs
index 9abc8e464..8f9a453bd 100644
--- a/src/Simplex/Chat/Messages/CIContent.hs
+++ b/src/Simplex/Chat/Messages/CIContent.hs
@@ -9,12 +9,14 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Simplex.Chat.Messages.CIContent where
 
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH  as JQ
 import Data.Int (Int64)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
@@ -34,7 +36,7 @@ import Simplex.Chat.Types.Util
 import Simplex.Messaging.Agent.Protocol (MsgErrorType (..), RatchetSyncState (..), SwitchPhase (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON)
-import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
+import Simplex.Messaging.Util (safeDecodeUtf8, tshow, (<$?>))
 
 data MsgDirection = MDRcv | MDSnd
   deriving (Eq, Show, Generic)
@@ -69,6 +71,13 @@ instance TestEquality SMsgDirection where
   testEquality SMDSnd SMDSnd = Just Refl
   testEquality _ _ = Nothing
 
+instance MsgDirectionI d => FromJSON (SMsgDirection d) where
+  parseJSON v = (\(AMsgDirection d) -> checkDirection d) . fromMsgDirection <$?> J.parseJSON v
+
+instance ToJSON (SMsgDirection d) where
+  toJSON = J.toJSON . toMsgDirection
+  toEncoding = J.toEncoding . toMsgDirection
+
 instance ToField (SMsgDirection d) where toField = toField . msgDirectionInt . toMsgDirection
 
 data AMsgDirection = forall d. MsgDirectionI d => AMsgDirection (SMsgDirection d)
@@ -92,6 +101,11 @@ instance MsgDirectionI 'MDRcv where msgDirection = SMDRcv
 
 instance MsgDirectionI 'MDSnd where msgDirection = SMDSnd
 
+checkDirection :: forall t d d'. (MsgDirectionI d, MsgDirectionI d') => t d' -> Either String (t d)
+checkDirection x = case testEquality (msgDirection @d) (msgDirection @d') of
+  Just Refl -> Right x
+  Nothing -> Left "bad direction"
+
 msgDirectionInt :: MsgDirection -> Int
 msgDirectionInt = \case
   MDRcv -> 0
@@ -481,27 +495,10 @@ msgDirToModeratedContent_ = \case
 ciModeratedText :: Text
 ciModeratedText = "moderated"
 
--- platform independent
-instance MsgDirectionI d => ToField (CIContent d) where
-  toField = toField . encodeJSON . dbJsonCIContent
-
--- platform specific
-instance MsgDirectionI d => ToJSON (CIContent d) where
-  toJSON = J.toJSON . jsonCIContent
-  toEncoding = J.toEncoding . jsonCIContent
-
 data ACIContent = forall d. MsgDirectionI d => ACIContent (SMsgDirection d) (CIContent d)
 
 deriving instance Show ACIContent
 
--- platform independent
-dbParseACIContent :: Text -> Either String ACIContent
-dbParseACIContent = fmap aciContentDBJSON . J.eitherDecodeStrict' . encodeUtf8
-
--- platform specific
-instance FromJSON ACIContent where
-  parseJSON = fmap aciContentJSON . J.parseJSON
-
 -- platform specific
 data JSONCIContent
   = JCISndMsgContent {msgContent :: MsgContent}
@@ -527,17 +524,9 @@ data JSONCIContent
   | JCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int}
   | JCIRcvChatFeatureRejected {feature :: ChatFeature}
   | JCIRcvGroupFeatureRejected {groupFeature :: GroupFeature}
-  | JCISndModerated
-  | JCIRcvModerated
+  | JCISndModerated {_nullary :: Maybe Int}
+  | JCIRcvModerated {_nullary :: Maybe Int}
   | JCIInvalidJSON {direction :: MsgDirection, json :: Text}
-  deriving (Generic)
-
-instance FromJSON JSONCIContent where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCI"
-
-instance ToJSON JSONCIContent where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCI"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCI"
 
 jsonCIContent :: forall d. MsgDirectionI d => CIContent d -> JSONCIContent
 jsonCIContent = \case
@@ -564,8 +553,8 @@ jsonCIContent = \case
   CISndGroupFeature groupFeature preference param -> JCISndGroupFeature {groupFeature, preference, param}
   CIRcvChatFeatureRejected feature -> JCIRcvChatFeatureRejected {feature}
   CIRcvGroupFeatureRejected groupFeature -> JCIRcvGroupFeatureRejected {groupFeature}
-  CISndModerated -> JCISndModerated
-  CIRcvModerated -> JCISndModerated
+  CISndModerated -> JCISndModerated Nothing
+  CIRcvModerated -> JCISndModerated Nothing
   CIInvalidJSON json -> JCIInvalidJSON (toMsgDirection $ msgDirection @d) json
 
 aciContentJSON :: JSONCIContent -> ACIContent
@@ -593,8 +582,8 @@ aciContentJSON = \case
   JCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param
   JCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature
   JCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature
-  JCISndModerated -> ACIContent SMDSnd CISndModerated
-  JCIRcvModerated -> ACIContent SMDRcv CIRcvModerated
+  JCISndModerated _ -> ACIContent SMDSnd CISndModerated
+  JCIRcvModerated _ -> ACIContent SMDRcv CIRcvModerated
   JCIInvalidJSON dir json -> case fromMsgDirection dir of
     AMsgDirection d -> ACIContent d $ CIInvalidJSON json
 
@@ -623,17 +612,9 @@ data DBJSONCIContent
   | DBJCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int}
   | DBJCIRcvChatFeatureRejected {feature :: ChatFeature}
   | DBJCIRcvGroupFeatureRejected {groupFeature :: GroupFeature}
-  | DBJCISndModerated
-  | DBJCIRcvModerated
+  | DBJCISndModerated {_nullary :: Maybe Int}
+  | DBJCIRcvModerated {_nullary :: Maybe Int}
   | DBJCIInvalidJSON {direction :: MsgDirection, json :: Text}
-  deriving (Generic)
-
-instance FromJSON DBJSONCIContent where
-  parseJSON = J.genericParseJSON . singleFieldJSON $ dropPrefix "DBJCI"
-
-instance ToJSON DBJSONCIContent where
-  toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "DBJCI"
-  toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "DBJCI"
 
 dbJsonCIContent :: forall d. MsgDirectionI d => CIContent d -> DBJSONCIContent
 dbJsonCIContent = \case
@@ -660,8 +641,8 @@ dbJsonCIContent = \case
   CISndGroupFeature groupFeature preference param -> DBJCISndGroupFeature {groupFeature, preference, param}
   CIRcvChatFeatureRejected feature -> DBJCIRcvChatFeatureRejected {feature}
   CIRcvGroupFeatureRejected groupFeature -> DBJCIRcvGroupFeatureRejected {groupFeature}
-  CISndModerated -> DBJCISndModerated
-  CIRcvModerated -> DBJCIRcvModerated
+  CISndModerated -> DBJCISndModerated Nothing
+  CIRcvModerated -> DBJCIRcvModerated Nothing
   CIInvalidJSON json -> DBJCIInvalidJSON (toMsgDirection $ msgDirection @d) json
 
 aciContentDBJSON :: DBJSONCIContent -> ACIContent
@@ -689,8 +670,8 @@ aciContentDBJSON = \case
   DBJCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param
   DBJCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature
   DBJCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature
-  DBJCISndModerated -> ACIContent SMDSnd CISndModerated
-  DBJCIRcvModerated -> ACIContent SMDRcv CIRcvModerated
+  DBJCISndModerated _ -> ACIContent SMDSnd CISndModerated
+  DBJCIRcvModerated _ -> ACIContent SMDRcv CIRcvModerated
   DBJCIInvalidJSON dir json -> case fromMsgDirection dir of
     AMsgDirection d -> ACIContent d $ CIInvalidJSON json
 
@@ -703,14 +684,7 @@ data CICallStatus
   | CISCallProgress
   | CISCallEnded
   | CISCallError
-  deriving (Show, Generic)
-
-instance FromJSON CICallStatus where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CISCall"
-
-instance ToJSON CICallStatus where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CISCall"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CISCall"
+  deriving (Show)
 
 ciCallInfoText :: CICallStatus -> Int -> Text
 ciCallInfoText status duration = case status of
@@ -722,3 +696,31 @@ ciCallInfoText status duration = case status of
   CISCallProgress -> "in progress " <> durationText duration
   CISCallEnded -> "ended " <> durationText duration
   CISCallError -> "error"
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "CISCall") ''CICallStatus)
+
+-- platform specific
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCI") ''JSONCIContent)
+
+-- platform independent
+$(JQ.deriveJSON (singleFieldJSON $ dropPrefix "DBJCI") ''DBJSONCIContent)
+
+-- platform independent
+instance MsgDirectionI d => ToField (CIContent d) where
+  toField = toField . encodeJSON . dbJsonCIContent
+
+-- platform specific
+instance MsgDirectionI d => ToJSON (CIContent d) where
+  toJSON = J.toJSON . jsonCIContent
+  toEncoding = J.toEncoding . jsonCIContent
+
+instance MsgDirectionI d => FromJSON (CIContent d) where
+  parseJSON v = (\(ACIContent _ c) -> checkDirection c) <$?> J.parseJSON v
+
+-- platform independent
+dbParseACIContent :: Text -> Either String ACIContent
+dbParseACIContent = fmap aciContentDBJSON . J.eitherDecodeStrict' . encodeUtf8
+
+-- platform specific
+instance FromJSON ACIContent where
+  parseJSON = fmap aciContentJSON . J.parseJSON
diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs
index bbdddf8ce..cb937441f 100644
--- a/src/Simplex/Chat/Protocol.hs
+++ b/src/Simplex/Chat/Protocol.hs
@@ -72,6 +72,9 @@ data ConnectionEntity
   | UserContactConnection {entityConnection :: Connection, userContact :: UserContact}
   deriving (Eq, Show, Generic)
 
+instance FromJSON ConnectionEntity where
+  parseJSON = J.genericParseJSON $ sumTypeJSON fstToLower
+
 instance ToJSON ConnectionEntity where
   toJSON = J.genericToJSON $ sumTypeJSON fstToLower
   toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 936c750c6..8f7a3b4f4 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -201,7 +201,7 @@ startRemoteCtrl =
           chatWriteVar remoteCtrlSession Nothing
           toView $ CRRemoteCtrlStopped {remoteCtrlId}
       chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted}
-      pure CRRemoteCtrlStarted
+      pure $ CRRemoteCtrlStarted Nothing
 
 discoverRemoteCtrls :: (ChatMonad m) => TM.TMap C.KeyHash TransportHost -> m ()
 discoverRemoteCtrls discovered = Discovery.openListener >>= go
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index b66e9a625..f13c3c84e 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -1,14 +1,14 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Simplex.Chat.Remote.Types where
 
 import Control.Concurrent.Async (Async)
-import Data.Aeson (ToJSON (..))
+import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
 import Data.Text (Text)
-import GHC.Generics (Generic)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -37,7 +37,9 @@ data RemoteCtrl = RemoteCtrl
     fingerprint :: C.KeyHash,
     accepted :: Maybe Bool
   }
-  deriving (Show, Generic, ToJSON)
+  deriving (Show)
+
+$(J.deriveJSON J.defaultOptions ''RemoteCtrl)
 
 data RemoteHostSession
   = RemoteHostSessionStarting
diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs
index e521cb43c..d005c3893 100644
--- a/src/Simplex/Chat/Store/Profiles.hs
+++ b/src/Simplex/Chat/Store/Profiles.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -59,7 +60,7 @@ where
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
-import Data.Aeson (ToJSON)
+import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -398,7 +399,7 @@ data UserContactLink = UserContactLink
   { connReqContact :: ConnReqContact,
     autoAccept :: Maybe AutoAccept
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON UserContactLink where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -406,7 +407,7 @@ data AutoAccept = AutoAccept
   { acceptIncognito :: IncognitoEnabled,
     autoReply :: Maybe MsgContent
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON AutoAccept where toEncoding = J.genericToEncoding J.defaultOptions
 
diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs
index 4dc4f6e82..64634dd29 100644
--- a/src/Simplex/Chat/Store/Shared.hs
+++ b/src/Simplex/Chat/Store/Shared.hs
@@ -16,7 +16,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Crypto.Random (ChaChaDRG, randomBytesGenerate)
-import Data.Aeson (ToJSON)
+import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
@@ -102,6 +102,9 @@ data StoreError
   | SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId}
   deriving (Show, Exception, Generic)
 
+instance FromJSON StoreError where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SE"
+
 instance ToJSON StoreError where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SE"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SE"
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index 0b143a757..088f23e05 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -15,6 +15,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -25,9 +26,10 @@
 module Simplex.Chat.Types where
 
 import Crypto.Number.Serialize (os2ip)
-import Data.Aeson (FromJSON (..), ToJSON (..), (.=))
+import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
+import qualified Data.Aeson.TH as JQ
 import qualified Data.Aeson.Types as JT
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString, pack, unpack)
@@ -112,18 +114,14 @@ data User = User
     sendRcptsContacts :: Bool,
     sendRcptsSmallGroups :: Bool
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON User where
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 data NewUser = NewUser
   { profile :: Maybe Profile,
     sameServers :: Bool,
     pastTimestamp :: Bool
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
 newtype B64UrlByteString = B64UrlByteString ByteString
   deriving (Eq, Show)
@@ -144,19 +142,13 @@ instance ToJSON B64UrlByteString where
   toEncoding = strToJEncoding
 
 data UserPwdHash = UserPwdHash {hash :: B64UrlByteString, salt :: B64UrlByteString}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON UserPwdHash where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data UserInfo = UserInfo
   { user :: User,
     unreadCount :: Int
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON UserInfo where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 type ContactId = Int64
 
@@ -179,11 +171,7 @@ data Contact = Contact
     contactGroupMemberId :: Maybe GroupMemberId,
     contactGrpInvSent :: Bool
   }
-  deriving (Eq, Show, Generic)
-
-instance ToJSON Contact where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 contactConn :: Contact -> Connection
 contactConn Contact {activeConn} = activeConn
@@ -221,6 +209,9 @@ instance FromField ContactStatus where fromField = fromTextField_ textDecode
 
 instance ToField ContactStatus where toField = toField . textEncode
 
+instance FromJSON ContactStatus where
+  parseJSON = textParseJSON "ContactStatus"
+
 instance ToJSON ContactStatus where
   toJSON = J.String . textEncode
   toEncoding = JE.text . textEncode
@@ -240,9 +231,7 @@ data ContactRef = ContactRef
     agentConnId :: AgentConnId,
     localDisplayName :: ContactName
   }
-  deriving (Eq, Show, Generic)
-
-instance ToJSON ContactRef where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data ContactOrGroupMember = CGMContact Contact | CGMGroupMember GroupInfo GroupMember
   deriving (Show)
@@ -262,15 +251,13 @@ data UserContact = UserContact
     connReqContact :: ConnReqContact,
     groupId :: Maybe GroupId
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON UserContact where toEncoding = J.genericToEncoding J.defaultOptions
 
 userContactGroupId :: UserContact -> Maybe GroupId
 userContactGroupId UserContact {groupId} = groupId
 
-instance ToJSON UserContact where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
-
 data UserContactRequest = UserContactRequest
   { contactRequestId :: Int64,
     agentInvitationId :: AgentInvId,
@@ -284,7 +271,7 @@ data UserContactRequest = UserContactRequest
     updatedAt :: UTCTime,
     xContactId :: Maybe XContactId
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON UserContactRequest where
   toEncoding = J.genericToEncoding J.defaultOptions
@@ -341,7 +328,7 @@ optionalFullName displayName fullName
   | otherwise = " (" <> fullName <> ")"
 
 data Group = Group {groupInfo :: GroupInfo, members :: [GroupMember]}
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON Group where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -359,7 +346,7 @@ data GroupInfo = GroupInfo
     updatedAt :: UTCTime,
     chatTs :: Maybe UTCTime
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON GroupInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -369,7 +356,7 @@ groupName' GroupInfo {localDisplayName = g} = g
 data GroupSummary = GroupSummary
   { currentMembers :: Int
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, FromJSON)
 
 instance ToJSON GroupSummary where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -639,7 +626,7 @@ data GroupMember = GroupMember
     memberContactProfileId :: ProfileId,
     activeConn :: Maybe Connection
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON GroupMember where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
@@ -710,6 +697,9 @@ instance ToJSON MemberId where
 data InvitedBy = IBContact {byContactId :: Int64} | IBUser | IBUnknown
   deriving (Eq, Show, Generic)
 
+instance FromJSON InvitedBy where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "IB"
+
 instance ToJSON InvitedBy where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "IB"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "IB"
@@ -803,6 +793,9 @@ instance FromField GroupMemberCategory where fromField = fromTextField_ textDeco
 
 instance ToField GroupMemberCategory where toField = toField . textEncode
 
+instance FromJSON GroupMemberCategory where
+  parseJSON = textParseJSON "GroupMemberCategory"
+
 instance ToJSON GroupMemberCategory where
   toJSON = J.String . textEncode
   toEncoding = JE.text . textEncode
@@ -840,6 +833,9 @@ instance FromField GroupMemberStatus where fromField = fromTextField_ textDecode
 
 instance ToField GroupMemberStatus where toField = toField . textEncode
 
+instance FromJSON GroupMemberStatus where
+  parseJSON = textParseJSON "GroupMemberStatus"
+
 instance ToJSON GroupMemberStatus where
   toJSON = J.String . textEncode
   toEncoding = JE.text . textEncode
@@ -931,7 +927,7 @@ data SndFileTransfer = SndFileTransfer
     fileDescrId :: Maybe Int64,
     fileInline :: Maybe InlineFileMode
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON SndFileTransfer where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -997,7 +993,7 @@ instance FromField InlineFileMode where fromField = fromTextField_ textDecode
 instance ToField InlineFileMode where toField = toField . textEncode
 
 instance FromJSON InlineFileMode where
-  parseJSON = J.withText "InlineFileMode" $ maybe (fail "bad InlineFileMode") pure . textDecode
+  parseJSON = textParseJSON "InlineFileMode"
 
 instance ToJSON InlineFileMode where
   toJSON = J.String . textEncode
@@ -1017,7 +1013,7 @@ data RcvFileTransfer = RcvFileTransfer
     -- SMP files are encrypted after all chunks are received
     cryptoArgs :: Maybe CryptoFileArgs
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON RcvFileTransfer where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -1026,7 +1022,7 @@ data XFTPRcvFile = XFTPRcvFile
     agentRcvFileId :: Maybe AgentRcvFileId,
     agentRcvFileDeleted :: Bool
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON XFTPRcvFile where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -1036,7 +1032,7 @@ data RcvFileDescr = RcvFileDescr
     fileDescrPartNo :: Int,
     fileDescrComplete :: Bool
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON RcvFileDescr where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -1048,6 +1044,9 @@ data RcvFileStatus
   | RFSCancelled (Maybe RcvFileInfo)
   deriving (Eq, Show, Generic)
 
+instance FromJSON RcvFileStatus where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RFS"
+
 instance ToJSON RcvFileStatus where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RFS"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RFS"
@@ -1065,7 +1064,7 @@ data RcvFileInfo = RcvFileInfo
     connId :: Maybe Int64,
     agentConnId :: Maybe AgentConnId
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON RcvFileInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -1094,6 +1093,9 @@ instance StrEncoding AgentConnId where
   strDecode s = AgentConnId <$> strDecode s
   strP = AgentConnId <$> strP
 
+instance FromJSON AgentConnId where
+  parseJSON = strParseJSON "AgentConnId"
+
 instance ToJSON AgentConnId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
@@ -1110,6 +1112,9 @@ instance StrEncoding AgentSndFileId where
   strDecode s = AgentSndFileId <$> strDecode s
   strP = AgentSndFileId <$> strP
 
+instance FromJSON AgentSndFileId where
+  parseJSON = strParseJSON "AgentSndFileId"
+
 instance ToJSON AgentSndFileId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
@@ -1126,6 +1131,9 @@ instance StrEncoding AgentRcvFileId where
   strDecode s = AgentRcvFileId <$> strDecode s
   strP = AgentRcvFileId <$> strP
 
+instance FromJSON AgentRcvFileId where
+  parseJSON = strParseJSON "AgentRcvFileId"
+
 instance ToJSON AgentRcvFileId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
@@ -1142,6 +1150,9 @@ instance StrEncoding AgentInvId where
   strDecode s = AgentInvId <$> strDecode s
   strP = AgentInvId <$> strP
 
+instance FromJSON AgentInvId where
+  parseJSON = strParseJSON "AgentInvId"
+
 instance ToJSON AgentInvId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
@@ -1158,6 +1169,9 @@ data FileTransfer
   | FTRcv {rcvFileTransfer :: RcvFileTransfer}
   deriving (Show, Generic)
 
+instance FromJSON FileTransfer where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "FT"
+
 instance ToJSON FileTransfer where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "FT"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "FT"
@@ -1172,7 +1186,7 @@ data FileTransferMeta = FileTransferMeta
     chunkSize :: Integer,
     cancelled :: Bool
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON FileTransferMeta where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -1182,7 +1196,7 @@ data XFTPSndFile = XFTPSndFile
     agentSndFileDeleted :: Bool,
     cryptoArgs :: Maybe CryptoFileArgs
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON XFTPSndFile where toEncoding = J.genericToEncoding J.defaultOptions
 
@@ -1197,6 +1211,9 @@ instance FromField FileStatus where fromField = fromTextField_ textDecode
 
 instance ToField FileStatus where toField = toField . textEncode
 
+instance FromJSON FileStatus where
+  parseJSON = textParseJSON "FileStatus"
+
 instance ToJSON FileStatus where
   toJSON = J.String . textEncode
   toEncoding = JE.text . textEncode
@@ -1250,11 +1267,9 @@ connDisabled :: Connection -> Bool
 connDisabled Connection {authErrCounter} = authErrCounter >= authErrDisableCount
 
 data SecurityCode = SecurityCode {securityCode :: Text, verifiedAt :: UTCTime}
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
-instance ToJSON SecurityCode where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+instance ToJSON SecurityCode where toEncoding = J.genericToEncoding J.defaultOptions
 
 verificationCode :: ByteString -> Text
 verificationCode = T.pack . unwords . chunks 5 . show . os2ip
@@ -1273,6 +1288,9 @@ aConnId Connection {agentConnId = AgentConnId cId} = cId
 connIncognito :: Connection -> Bool
 connIncognito Connection {customUserProfileId} = isJust customUserProfileId
 
+instance FromJSON Connection where
+  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
+
 instance ToJSON Connection where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
@@ -1290,7 +1308,7 @@ data PendingContactConnection = PendingContactConnection
     createdAt :: UTCTime,
     updatedAt :: UTCTime
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 aConnId' :: PendingContactConnection -> ConnId
 aConnId' PendingContactConnection {pccAgentConnId = AgentConnId cId} = cId
@@ -1318,6 +1336,9 @@ instance FromField ConnStatus where fromField = fromTextField_ textDecode
 
 instance ToField ConnStatus where toField = toField . textEncode
 
+instance FromJSON ConnStatus where
+  parseJSON = textParseJSON "ConnStatus"
+
 instance ToJSON ConnStatus where
   toJSON = J.String . textEncode
   toEncoding = JE.text . textEncode
@@ -1348,6 +1369,9 @@ instance FromField ConnType where fromField = fromTextField_ textDecode
 
 instance ToField ConnType where toField = toField . textEncode
 
+instance FromJSON ConnType where
+  parseJSON = textParseJSON "ConnType"
+
 instance ToJSON ConnType where
   toJSON = J.String . textEncode
   toEncoding = JE.text . textEncode
@@ -1550,6 +1574,24 @@ instance ToJSON ChatVersionRange where
 
 newtype JVersionRange = JVersionRange {fromJVersionRange :: VersionRange} deriving (Eq, Show)
 
+instance FromJSON JVersionRange where
+  parseJSON = J.withObject "JVersionRange" $ \o -> do
+    minv <- o .: "minVersion"
+    maxv <- o .: "maxVersion"
+    maybe (fail "bad version range") (pure . JVersionRange) $ safeVersionRange minv maxv
+
 instance ToJSON JVersionRange where
   toJSON (JVersionRange (VersionRange minV maxV)) = J.object ["minVersion" .= minV, "maxVersion" .= maxV]
   toEncoding (JVersionRange (VersionRange minV maxV)) = J.pairs $ "minVersion" .= minV <> "maxVersion" .= maxV
+
+$(JQ.deriveJSON defOpts ''UserPwdHash)
+
+$(JQ.deriveJSON defOpts ''User)
+
+$(JQ.deriveJSON defOpts ''NewUser)
+
+$(JQ.deriveJSON defOpts ''UserInfo)
+
+$(JQ.deriveJSON defOpts ''Contact)
+
+$(JQ.deriveJSON defOpts ''ContactRef)
diff --git a/src/Simplex/Chat/Types/Preferences.hs b/src/Simplex/Chat/Types/Preferences.hs
index c53e4476f..c7555e18a 100644
--- a/src/Simplex/Chat/Types/Preferences.hs
+++ b/src/Simplex/Chat/Types/Preferences.hs
@@ -338,7 +338,7 @@ data ContactUserPreferences = ContactUserPreferences
     voice :: ContactUserPreference VoicePreference,
     calls :: ContactUserPreference CallsPreference
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show, Generic, FromJSON)
 
 data ContactUserPreference p = ContactUserPreference
   { enabled :: PrefEnabled,
@@ -352,8 +352,13 @@ data ContactUserPref p = CUPContact {preference :: p} | CUPUser {preference :: p
 
 instance ToJSON ContactUserPreferences where toEncoding = J.genericToEncoding J.defaultOptions
 
+instance FromJSON p => FromJSON (ContactUserPreference p) where parseJSON = J.genericParseJSON J.defaultOptions
+
 instance ToJSON p => ToJSON (ContactUserPreference p) where toEncoding = J.genericToEncoding J.defaultOptions
 
+instance FromJSON p => FromJSON (ContactUserPref p) where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CUP"
+
 instance ToJSON p => ToJSON (ContactUserPref p) where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CUP"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CUP"
diff --git a/src/Simplex/Chat/Types/Util.hs b/src/Simplex/Chat/Types/Util.hs
index fffdd24b9..8681e9908 100644
--- a/src/Simplex/Chat/Types/Util.hs
+++ b/src/Simplex/Chat/Types/Util.hs
@@ -28,3 +28,6 @@ fromBlobField_ p = \case
       Right k -> Ok k
       Left e -> returnError ConversionFailed f ("could not parse field: " ++ e)
   f -> returnError ConversionFailed f "expecting SQLBlob column type"
+
+defOpts :: J.Options
+defOpts = J.defaultOptions {J.omitNothingFields = True}
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 842a84cc6..f32b1835e 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -73,10 +73,10 @@ responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> TimeZone ->
 responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz = \case
   CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
   CRUsersList users -> viewUsersList users
-  CRChatStarted -> ["chat started"]
-  CRChatRunning -> ["chat is running"]
-  CRChatStopped -> ["chat stopped"]
-  CRChatSuspended -> ["chat suspended"]
+  CRChatStarted _ -> ["chat started"]
+  CRChatRunning _ -> ["chat is running"]
+  CRChatStopped _ -> ["chat stopped"]
+  CRChatSuspended _ -> ["chat suspended"]
   CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [plain . bshow $ J.encode chats]
   CRChats chats -> viewChats ts tz chats
   CRApiChat u chat -> ttyUser u $ if testView then testViewChat chat else [plain . bshow $ J.encode chat]
@@ -267,7 +267,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
   CRRemoteHostDeleted rhId -> ["remote host " <> sShow rhId <> " deleted"]
   CRRemoteCtrlList cs -> viewRemoteCtrls cs
   CRRemoteCtrlRegistered rcId -> ["remote controller " <> sShow rcId <> " registered"]
-  CRRemoteCtrlStarted -> ["remote controller started"]
+  CRRemoteCtrlStarted _ -> ["remote controller started"]
   CRRemoteCtrlAnnounce fingerprint -> ["remote controller announced", "connection code:", plain $ strEncode fingerprint]
   CRRemoteCtrlFound rc -> ["remote controller found:", viewRemoteCtrl rc]
   CRRemoteCtrlAccepted rcId -> ["remote controller " <> sShow rcId <> " accepted"]
diff --git a/stack.yaml b/stack.yaml
index bce5dd3a6..9a343bcad 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: ec1b72cb8013a65a5d9783104a47ae44f5730089
+    commit: 96a38505d63ec9a12096991e7725b250e397af72
   - github: kazu-yamamoto/http2
     commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
   # - ../direct-sqlcipher

From a273c6859697f70c798881db825e766282c83a85 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 5 Oct 2023 22:33:48 +0100
Subject: [PATCH 08/69] core: rename migration, pin dependencies

---
 package.yaml                                  |  4 +--
 simplex-chat.cabal                            | 30 +++++++++----------
 ...ller.hs => M20231005_remote_controller.hs} | 10 +++----
 src/Simplex/Chat/Store/Migrations.hs          |  6 ++--
 4 files changed, 25 insertions(+), 25 deletions(-)
 rename src/Simplex/Chat/Migrations/{M20230922_remote_controller.hs => M20231005_remote_controller.hs} (84%)

diff --git a/package.yaml b/package.yaml
index 663ae5bc2..f7fc61478 100644
--- a/package.yaml
+++ b/package.yaml
@@ -32,7 +32,7 @@ dependencies:
   - exceptions == 0.10.*
   - filepath == 1.4.*
   - http-types == 0.12.*
-  - http2
+  - http2 == 4.1.*
   - memory == 0.18.*
   - mtl == 2.3.*
   - network >= 3.1.2.7 && < 3.2
@@ -50,7 +50,7 @@ dependencies:
   - terminal == 0.2.*
   - text == 2.0.*
   - time == 1.9.*
-  - tls
+  - tls >= 1.6.0 && < 1.7
   - unliftio == 0.2.*
   - unliftio-core == 0.2.*
   - zip == 2.0.*
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 8963203c1..8fa33f07f 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -113,8 +113,8 @@ library
       Simplex.Chat.Migrations.M20230903_connections_to_subscribe
       Simplex.Chat.Migrations.M20230913_member_contacts
       Simplex.Chat.Migrations.M20230914_member_probes
-      Simplex.Chat.Migrations.M20230922_remote_controller
       Simplex.Chat.Migrations.M20230926_contact_status
+      Simplex.Chat.Migrations.M20231005_remote_controller
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared
@@ -170,7 +170,7 @@ library
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2
+    , http2 ==4.1.*
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -188,7 +188,7 @@ library
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
-    , tls
+    , tls >=1.6.0 && <1.7
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
@@ -223,7 +223,7 @@ executable simplex-bot
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2
+    , http2 ==4.1.*
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -242,7 +242,7 @@ executable simplex-bot
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
-    , tls
+    , tls >=1.6.0 && <1.7
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
@@ -277,7 +277,7 @@ executable simplex-bot-advanced
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2
+    , http2 ==4.1.*
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -296,7 +296,7 @@ executable simplex-bot-advanced
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
-    , tls
+    , tls >=1.6.0 && <1.7
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
@@ -333,7 +333,7 @@ executable simplex-broadcast-bot
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2
+    , http2 ==4.1.*
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -352,7 +352,7 @@ executable simplex-broadcast-bot
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
-    , tls
+    , tls >=1.6.0 && <1.7
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
@@ -388,7 +388,7 @@ executable simplex-chat
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2
+    , http2 ==4.1.*
     , memory ==0.18.*
     , mtl ==2.3.*
     , network ==3.1.*
@@ -407,7 +407,7 @@ executable simplex-chat
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
-    , tls
+    , tls >=1.6.0 && <1.7
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
@@ -447,7 +447,7 @@ executable simplex-directory-service
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2
+    , http2 ==4.1.*
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -466,7 +466,7 @@ executable simplex-directory-service
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
-    , tls
+    , tls >=1.6.0 && <1.7
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
@@ -529,7 +529,7 @@ test-suite simplex-chat-test
     , filepath ==1.4.*
     , hspec ==2.11.*
     , http-types ==0.12.*
-    , http2
+    , http2 ==4.1.*
     , memory ==0.18.*
     , mtl ==2.3.*
     , network ==3.1.*
@@ -549,7 +549,7 @@ test-suite simplex-chat-test
     , terminal ==0.2.*
     , text ==2.0.*
     , time ==1.9.*
-    , tls
+    , tls >=1.6.0 && <1.7
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , zip ==2.0.*
diff --git a/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs b/src/Simplex/Chat/Migrations/M20231005_remote_controller.hs
similarity index 84%
rename from src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
rename to src/Simplex/Chat/Migrations/M20231005_remote_controller.hs
index 21d653d12..0cb863499 100644
--- a/src/Simplex/Chat/Migrations/M20230922_remote_controller.hs
+++ b/src/Simplex/Chat/Migrations/M20231005_remote_controller.hs
@@ -1,12 +1,12 @@
 {-# LANGUAGE QuasiQuotes #-}
 
-module Simplex.Chat.Migrations.M20230922_remote_controller where
+module Simplex.Chat.Migrations.M20231005_remote_controller where
 
 import Database.SQLite.Simple (Query)
 import Database.SQLite.Simple.QQ (sql)
 
-m20230922_remote_controller :: Query
-m20230922_remote_controller =
+m20231005_remote_controller :: Query
+m20231005_remote_controller =
   [sql|
 CREATE TABLE remote_hosts ( -- hosts known to a controlling app
   remote_host_id INTEGER PRIMARY KEY AUTOINCREMENT,
@@ -25,8 +25,8 @@ CREATE TABLE remote_controllers ( -- controllers known to a hosting app
 );
 |]
 
-down_m20230922_remote_controller :: Query
-down_m20230922_remote_controller =
+down_m20231005_remote_controller :: Query
+down_m20231005_remote_controller =
   [sql|
 DROP TABLE remote_hosts;
 DROP TABLE remote_controllers;
diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs
index c694a5371..5d789003a 100644
--- a/src/Simplex/Chat/Store/Migrations.hs
+++ b/src/Simplex/Chat/Store/Migrations.hs
@@ -81,8 +81,8 @@ import Simplex.Chat.Migrations.M20230829_connections_chat_vrange
 import Simplex.Chat.Migrations.M20230903_connections_to_subscribe
 import Simplex.Chat.Migrations.M20230913_member_contacts
 import Simplex.Chat.Migrations.M20230914_member_probes
-import Simplex.Chat.Migrations.M20230922_remote_controller
 import Simplex.Chat.Migrations.M20230926_contact_status
+import Simplex.Chat.Migrations.M20231005_remote_controller
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -164,8 +164,8 @@ schemaMigrations =
     ("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe),
     ("20230913_member_contacts", m20230913_member_contacts, Just down_m20230913_member_contacts),
     ("20230914_member_probes", m20230914_member_probes, Just down_m20230914_member_probes),
-    ("20230922_remote_controller", m20230922_remote_controller, Just down_m20230922_remote_controller),
-    ("20230926_contact_status", m20230926_contact_status, Just down_m20230926_contact_status)
+    ("20230926_contact_status", m20230926_contact_status, Just down_m20230926_contact_status),
+    ("20231005_remote_controller", m20231005_remote_controller, Just down_m20231005_remote_controller)
   ]
 
 -- | The list of migrations in ascending order by date

From 91561da351c19ce621f0723620519999f162f6b3 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Sat, 7 Oct 2023 16:23:24 +0300
Subject: [PATCH 09/69] core: http transport for remote session (#3178)

* Wire some of the session endpoints

* Start sending remote commands

* Expand remote controller

- Fix queues for pumping to remote
- Add 3-way test
- WIP: Add TTY wrapper for remote hosts
- Stop remote controller w/o ids to match starting

* Fix view events

* Drop notifications, add message test

* refactor, receive test

* hunt down stray asyncs

* Take discovery sockets in brackets

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 apps/simplex-chat/Main.hs                     |   7 +-
 .../src/Directory/Service.hs                  |   2 +-
 src/Simplex/Chat.hs                           |  17 +-
 src/Simplex/Chat/Controller.hs                |  95 +++++++-
 src/Simplex/Chat/Messages.hs                  |   4 +-
 src/Simplex/Chat/Remote.hs                    | 219 ++++++++++++------
 src/Simplex/Chat/Remote/Discovery.hs          |  26 ++-
 src/Simplex/Chat/Remote/Types.hs              |  24 --
 src/Simplex/Chat/Terminal/Input.hs            |  10 +-
 src/Simplex/Chat/Terminal/Output.hs           |  18 +-
 src/Simplex/Chat/Types.hs                     |   1 +
 src/Simplex/Chat/View.hs                      |  22 +-
 tests/ChatTests/Utils.hs                      |   3 +
 tests/RemoteTests.hs                          | 100 ++++++--
 14 files changed, 376 insertions(+), 172 deletions(-)

diff --git a/apps/simplex-chat/Main.hs b/apps/simplex-chat/Main.hs
index 8dd02623e..c2ad7e7eb 100644
--- a/apps/simplex-chat/Main.hs
+++ b/apps/simplex-chat/Main.hs
@@ -3,10 +3,11 @@
 module Main where
 
 import Control.Concurrent (threadDelay)
+import Control.Concurrent.STM.TVar (readTVarIO)
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.LocalTime (getCurrentTimeZone)
 import Server
-import Simplex.Chat.Controller (versionNumber, versionString)
+import Simplex.Chat.Controller (currentRemoteHost, versionNumber, versionString)
 import Simplex.Chat.Core
 import Simplex.Chat.Options
 import Simplex.Chat.Terminal
@@ -28,10 +29,12 @@ main = do
         t <- withTerminal pure
         simplexChatTerminal terminalChatConfig opts t
     else simplexChatCore terminalChatConfig opts Nothing $ \user cc -> do
+      rh <- readTVarIO $ currentRemoteHost cc
+      let cmdRH = rh -- response RemoteHost is the same as for the command itself
       r <- sendChatCmdStr cc chatCmd
       ts <- getCurrentTime
       tz <- getCurrentTimeZone
-      putStrLn $ serializeChatResponse (Just user) ts tz r
+      putStrLn $ serializeChatResponse (rh, Just user) ts tz cmdRH r
       threadDelay $ chatCmdDelay opts * 1000000
 
 welcome :: ChatOpts -> IO ()
diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs
index 7ed39847a..a30638249 100644
--- a/apps/simplex-directory-service/src/Directory/Service.hs
+++ b/apps/simplex-directory-service/src/Directory/Service.hs
@@ -494,7 +494,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User {
           sendChatCmdStr cc cmdStr >>= \r -> do
             ts <- getCurrentTime
             tz <- getCurrentTimeZone
-            sendReply $ serializeChatResponse (Just user) ts tz r
+            sendReply $ serializeChatResponse (Nothing, Just user) ts tz Nothing r
         DCCommandError tag -> sendReply $ "Command error: " <> show tag
       | otherwise = sendReply "You are not allowed to use this command"
       where
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index bcd23f44e..dc06d082b 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -193,6 +193,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
       firstTime = dbNew chatStore
   activeTo <- newTVarIO ActiveNone
   currentUser <- newTVarIO user
+  currentRemoteHost <- newTVarIO Nothing
   servers <- agentServers config
   smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore
   agentAsync <- newTVarIO Nothing
@@ -216,7 +217,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
   showLiveItems <- newTVarIO False
   userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
   tempDirectory <- newTVarIO tempDir
-  pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, subscriptionMode, chatLock, sndFiles, rcvFiles, currentCalls, remoteHostSessions, remoteCtrlSession, config, sendNotification, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile}
+  pure ChatController {activeTo, firstTime, currentUser, currentRemoteHost, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, subscriptionMode, chatLock, sndFiles, rcvFiles, currentCalls, remoteHostSessions, remoteCtrlSession, config, sendNotification, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile}
   where
     configServers :: DefaultAgentServers
     configServers =
@@ -327,7 +328,9 @@ restoreCalls = do
   atomically $ writeTVar calls callsMap
 
 stopChatController :: forall m. MonadUnliftIO m => ChatController -> m ()
-stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags} = do
+stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags, remoteHostSessions, remoteCtrlSession} = do
+  readTVarIO remoteHostSessions >>= mapM_ cancelRemoteHostSession
+  readTVarIO remoteCtrlSession >>= mapM_ cancelRemoteCtrlSession_
   disconnectAgentClient smpAgent
   readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2)
   closeFiles sndFiles
@@ -349,8 +352,8 @@ execChatCommand rh s = do
   case parseChatCommand s of
     Left e -> pure $ chatCmdError u e
     Right cmd -> case rh of
-      Nothing -> execChatCommand_ u cmd
-      Just remoteHostId -> execRemoteCommand u remoteHostId (s, cmd)
+      Just remoteHostId | allowRemoteCommand cmd -> execRemoteCommand u remoteHostId (s, cmd)
+      _ -> execChatCommand_ u cmd
 
 execChatCommand' :: ChatMonad' m => ChatCommand -> m ChatResponse
 execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` cmd)
@@ -1843,10 +1846,10 @@ processChatCommand = \case
   StartRemoteHost rh -> startRemoteHost rh
   StopRemoteHost rh -> closeRemoteHostSession rh
   DeleteRemoteHost rh -> deleteRemoteHost rh
-  StartRemoteCtrl -> startRemoteCtrl
+  StartRemoteCtrl -> startRemoteCtrl (execChatCommand Nothing)
   AcceptRemoteCtrl rc -> acceptRemoteCtrl rc
   RejectRemoteCtrl rc -> rejectRemoteCtrl rc
-  StopRemoteCtrl rc -> stopRemoteCtrl rc
+  StopRemoteCtrl -> stopRemoteCtrl
   RegisterRemoteCtrl oob -> registerRemoteCtrl oob
   ListRemoteCtrls -> listRemoteCtrls
   DeleteRemoteCtrl rc -> deleteRemoteCtrl rc
@@ -5631,7 +5634,7 @@ chatCommandP =
       "/list remote ctrls" $> ListRemoteCtrls,
       "/accept remote ctrl " *> (AcceptRemoteCtrl <$> A.decimal),
       "/reject remote ctrl " *> (RejectRemoteCtrl <$> A.decimal),
-      "/stop remote ctrl " *> (StopRemoteCtrl <$> A.decimal),
+      "/stop remote ctrl" $> StopRemoteCtrl,
       "/delete remote ctrl " *> (DeleteRemoteCtrl <$> A.decimal),
       ("/quit" <|> "/q" <|> "/exit") $> QuitChat,
       ("/version" <|> "/v") $> ShowVersion,
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 986eaf073..dad5138bc 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -72,6 +72,7 @@ import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), Cor
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost)
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import Simplex.Messaging.Util (allFinally, catchAllErrors, liftEitherError, tryAllErrors, (<$$>))
 import Simplex.Messaging.Version
 import System.IO (Handle)
@@ -171,6 +172,7 @@ data ChatDatabase = ChatDatabase {chatStore :: SQLiteStore, agentStore :: SQLite
 
 data ChatController = ChatController
   { currentUser :: TVar (Maybe User),
+    currentRemoteHost :: TVar (Maybe RemoteHostId),
     activeTo :: TVar ActiveTo,
     firstTime :: Bool,
     smpAgent :: AgentClient,
@@ -424,6 +426,7 @@ data ChatCommand
   | CreateRemoteHost -- ^ Configure a new remote host
   | ListRemoteHosts
   | StartRemoteHost RemoteHostId -- ^ Start and announce a remote host
+  -- | SwitchRemoteHost (Maybe RemoteHostId) -- ^ Switch current remote host
   | StopRemoteHost RemoteHostId -- ^ Shut down a running session
   | DeleteRemoteHost RemoteHostId -- ^ Unregister remote host and remove its data
   | RegisterRemoteCtrl RemoteCtrlOOB -- ^ Register OOB data for satellite discovery and handshake
@@ -431,7 +434,7 @@ data ChatCommand
   | ListRemoteCtrls
   | AcceptRemoteCtrl RemoteCtrlId -- ^ Accept discovered data and store confirmation
   | RejectRemoteCtrl RemoteCtrlId -- ^ Reject and blacklist discovered data
-  | StopRemoteCtrl RemoteCtrlId -- ^ Stop listening for announcements or terminate an active session
+  | StopRemoteCtrl -- ^ Stop listening for announcements or terminate an active session
   | DeleteRemoteCtrl RemoteCtrlId -- ^ Remove all local data associated with a satellite session
   | QuitChat
   | ShowVersion
@@ -442,6 +445,29 @@ data ChatCommand
   | GetAgentSubsDetails
   deriving (Show)
 
+allowRemoteCommand :: ChatCommand -> Bool -- XXX: consider using Relay/Block/ForceLocal
+allowRemoteCommand = \case
+  StartChat {} -> False
+  APIStopChat -> False
+  APIActivateChat -> False
+  APISuspendChat {} -> False
+  SetTempFolder {} -> False
+  QuitChat -> False
+  CreateRemoteHost -> False
+  ListRemoteHosts -> False
+  StartRemoteHost {} -> False
+  -- SwitchRemoteHost {} -> False
+  StopRemoteHost {} -> False
+  DeleteRemoteHost {} -> False
+  RegisterRemoteCtrl {} -> False
+  StartRemoteCtrl -> False
+  ListRemoteCtrls -> False
+  AcceptRemoteCtrl {} -> False
+  RejectRemoteCtrl {} -> False
+  StopRemoteCtrl -> False
+  DeleteRemoteCtrl {} -> False
+  _ -> True
+
 data ChatResponse
   = CRActiveUser {user :: User}
   | CRUsersList {users :: [UserInfo]}
@@ -619,7 +645,7 @@ data ChatResponse
   | CRRemoteCtrlRejected {remoteCtrlId :: RemoteCtrlId}
   | CRRemoteCtrlConnecting {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
   | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
-  | CRRemoteCtrlStopped {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlStopped {_nullary :: Maybe Int}
   | CRRemoteCtrlDeleted {remoteCtrlId :: RemoteCtrlId}
   | CRSQLResult {rows :: [Text]}
   | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
@@ -638,6 +664,27 @@ data ChatResponse
   | CRTimedAction {action :: String, durationMilliseconds :: Int64}
   deriving (Show)
 
+allowRemoteEvent :: ChatResponse -> Bool
+allowRemoteEvent = \case
+  CRRemoteHostCreated {} -> False
+  CRRemoteHostList {} -> False
+  CRRemoteHostStarted {} -> False
+  CRRemoteHostConnected {} -> False
+  CRRemoteHostStopped {} -> False
+  CRRemoteHostDeleted {} -> False
+  CRRemoteCtrlList {} -> False
+  CRRemoteCtrlRegistered {} -> False
+  CRRemoteCtrlStarted {} -> False
+  CRRemoteCtrlAnnounce {} -> False
+  CRRemoteCtrlFound {} -> False
+  CRRemoteCtrlAccepted {} -> False
+  CRRemoteCtrlRejected {} -> False
+  CRRemoteCtrlConnecting {} -> False
+  CRRemoteCtrlConnected {} -> False
+  CRRemoteCtrlStopped {} -> False
+  CRRemoteCtrlDeleted {} -> False
+  _ -> True
+
 logResponseToFile :: ChatResponse -> Bool
 logResponseToFile = \case
   CRContactsDisconnected {} -> True
@@ -1107,6 +1154,27 @@ instance ToJSON ArchiveError where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "AE"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "AE"
 
+data RemoteHostSession
+  = RemoteHostSessionStarting
+      { announcer :: Async ()
+      }
+  | RemoteHostSessionStarted
+      { -- | Path for local resources to be synchronized with host
+        storePath :: FilePath,
+        ctrlClient :: HTTP2Client
+      }
+
+data RemoteCtrlSession = RemoteCtrlSession
+  { -- | Server side of transport to process remote commands and forward notifications
+    discoverer :: Async (),
+    supervisor :: Async (),
+    hostServer :: Maybe (Async ()),
+    discovered :: TMap C.KeyHash TransportHost,
+    accepted :: TMVar RemoteCtrlId,
+    remoteOutputQ :: TBQueue ChatResponse,
+    remoteNotifyQ :: TBQueue Notification
+  }
+
 type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m)
 
 type ChatMonad m = (ChatMonad' m, MonadError ChatError m)
@@ -1152,16 +1220,19 @@ unsetActive a = asks activeTo >>= atomically . (`modifyTVar` unset)
 
 -- | Emit local events.
 toView :: ChatMonad' m => ChatResponse -> m ()
-toView = toView_ Nothing
-
--- | Used by transport to mark remote events with source.
-toViewRemote :: ChatMonad' m => RemoteHostId -> ChatResponse -> m ()
-toViewRemote = toView_ . Just
-
-toView_ :: ChatMonad' m => Maybe RemoteHostId -> ChatResponse -> m ()
-toView_ rh event = do
-  q <- asks outputQ
-  atomically $ writeTBQueue q (Nothing, rh, event)
+toView event = do
+  localQ <- asks outputQ
+  chatReadVar remoteCtrlSession >>= \case
+    Nothing -> atomically $ writeTBQueue localQ (Nothing, Nothing, event)
+    Just RemoteCtrlSession {remoteOutputQ} ->
+      if allowRemoteEvent event
+        then do
+          -- TODO: filter events or let the UI ignore trigger events by itself?
+          -- traceM $ "Sending event to remote Q: " <> show event
+          atomically $ writeTBQueue remoteOutputQ event -- TODO: check full?
+        else do
+          -- traceM $ "Sending event to local Q: " <> show event
+          atomically $ writeTBQueue localQ (Nothing, Nothing, event)
 
 withStore' :: ChatMonad m => (DB.Connection -> IO a) -> m a
 withStore' action = withStore $ liftIO . action
diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs
index b9ce95373..87bd8f4ef 100644
--- a/src/Simplex/Chat/Messages.hs
+++ b/src/Simplex/Chat/Messages.hs
@@ -43,7 +43,7 @@ import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptSta
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, parseAll, sumTypeJSON)
+import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, parseAll, enumJSON, sumTypeJSON)
 import Simplex.Messaging.Protocol (MsgBody)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
 
@@ -880,7 +880,7 @@ data SndCIStatusProgress
   deriving (Eq, Show, Generic)
 
 instance FromJSON SndCIStatusProgress where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SSP"
+  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "SSP"
 
 instance ToJSON SndCIStatusProgress where
   toJSON = J.genericToJSON . enumJSON $ dropPrefix "SSP"
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 8f7a3b4f4..722274335 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -4,12 +4,15 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 
 module Simplex.Chat.Remote where
 
+import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
+import Control.Monad.Reader (asks)
 import Control.Monad.STM (retry)
 import Crypto.Random (getRandomBytes)
 import qualified Data.Aeson as J
@@ -18,9 +21,13 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base64.URL as B64U
 import qualified Data.ByteString.Char8 as B
 import Data.List.NonEmpty (NonEmpty (..))
+import Data.Maybe (fromMaybe)
 import qualified Data.Map.Strict as M
+import qualified Data.Text as T
 import qualified Network.HTTP.Types as HTTP
+import qualified Network.HTTP.Types.Status as Status
 import qualified Network.HTTP2.Client as HTTP2Client
+import qualified Network.HTTP2.Server as HTTP2Server
 import Network.Socket (SockAddr (..), hostAddressToTuple)
 import Simplex.Chat.Controller
 import qualified Simplex.Chat.Remote.Discovery as Discovery
@@ -36,7 +43,7 @@ import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HTTP2
 import qualified Simplex.Messaging.Transport.HTTP2.Server as HTTP2
-import Simplex.Messaging.Util (bshow)
+import Simplex.Messaging.Util (bshow, ifM, tshow)
 import System.Directory (getFileSize)
 import UnliftIO
 
@@ -54,32 +61,67 @@ withRemoteHost remoteHostId action =
 
 startRemoteHost :: (ChatMonad m) => RemoteHostId -> m ChatResponse
 startRemoteHost remoteHostId = do
-  M.lookup remoteHostId <$> chatReadVar remoteHostSessions >>= \case
+  asks remoteHostSessions >>= atomically . TM.lookup remoteHostId >>= \case
     Just _ -> throwError $ ChatErrorRemoteHost remoteHostId RHBusy
-    Nothing -> withRemoteHost remoteHostId run
-  where
-    run RemoteHost {storePath, caKey, caCert} = do
-      announcer <- async $ do
-        cleanup <- toIO $ closeRemoteHostSession remoteHostId >>= toView
-        let parent = (C.signatureKeyPair caKey, caCert)
-        sessionCreds <- liftIO $ genCredentials (Just parent) (0, 24) "Session"
-        let (fingerprint, credentials) = tlsCredentials $ sessionCreds :| [parent]
-        Discovery.announceRevHTTP2 cleanup fingerprint credentials >>= \case
-          Left todo'err -> liftIO cleanup -- TODO: log error
-          Right ctrlClient -> do
-            chatModifyVar remoteHostSessions $ M.insert remoteHostId RemoteHostSessionStarted {storePath, ctrlClient}
-            -- TODO: start streaming outputQ
-            toView CRRemoteHostConnected {remoteHostId}
+    Nothing -> withRemoteHost remoteHostId $ \rh -> do
+      announcer <- async $ run rh
       chatModifyVar remoteHostSessions $ M.insert remoteHostId RemoteHostSessionStarting {announcer}
       pure CRRemoteHostStarted {remoteHostId}
+  where
+    cleanup finished = do
+      logInfo "Remote host http2 client fininshed"
+      atomically $ writeTVar finished True
+      closeRemoteHostSession remoteHostId >>= toView
+    run RemoteHost {storePath, caKey, caCert} = do
+      finished <- newTVarIO False
+      let parent = (C.signatureKeyPair caKey, caCert)
+      sessionCreds <- liftIO $ genCredentials (Just parent) (0, 24) "Session"
+      let (fingerprint, credentials) = tlsCredentials $ sessionCreds :| [parent]
+      Discovery.announceRevHTTP2 (cleanup finished) fingerprint credentials >>= \case
+        Left h2ce -> do
+          logError $ "Failed to set up remote host connection: " <> tshow h2ce
+          cleanup finished
+        Right ctrlClient -> do
+          chatModifyVar remoteHostSessions $ M.insert remoteHostId RemoteHostSessionStarted {storePath, ctrlClient}
+          chatWriteVar currentRemoteHost $ Just remoteHostId
+          sendHello ctrlClient >>= \case
+            Left h2ce -> do
+              logError $ "Failed to send initial remote host request: " <> tshow h2ce
+              cleanup finished
+            Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
+              logDebug $ "Got initial from remote host: " <> tshow bodyHead
+              _ <- asks outputQ >>= async . pollRemote finished ctrlClient "/recv" (Nothing, Just remoteHostId,)
+              toView CRRemoteHostConnected {remoteHostId}
+
+sendHello :: (ChatMonad m) => HTTP2Client -> m (Either HTTP2.HTTP2ClientError HTTP2.HTTP2Response)
+sendHello http = liftIO (HTTP2.sendRequestDirect http req Nothing)
+  where
+    req = HTTP2Client.requestNoBody "GET" "/" mempty
+
+pollRemote :: (ChatMonad m, J.FromJSON a) => TVar Bool -> HTTP2Client -> ByteString -> (a -> b) -> TBQueue b -> m ()
+pollRemote finished http path f queue = loop
+  where
+    loop = do
+      liftIO (HTTP2.sendRequestDirect http req Nothing) >>= \case
+        Left e -> logError $ "pollRemote: " <> tshow (path, e)
+        Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} ->
+          case J.eitherDecodeStrict' bodyHead of
+            Left e -> logError $ "pollRemote/decode: " <> tshow (path, e)
+            Right o -> atomically $ writeTBQueue queue (f o)
+      readTVarIO finished >>= (`unless` loop)
+    req = HTTP2Client.requestNoBody "GET" path mempty
 
 closeRemoteHostSession :: (ChatMonad m) => RemoteHostId -> m ChatResponse
 closeRemoteHostSession remoteHostId = withRemoteHostSession remoteHostId $ \session -> do
-  case session of
-    RemoteHostSessionStarting {announcer} -> cancel announcer
-    RemoteHostSessionStarted {ctrlClient} -> liftIO (HTTP2.closeHTTP2Client ctrlClient)
+  liftIO $ cancelRemoteHostSession session
+  chatWriteVar currentRemoteHost Nothing
   chatModifyVar remoteHostSessions $ M.delete remoteHostId
-  pure CRRemoteHostStopped { remoteHostId }
+  pure CRRemoteHostStopped {remoteHostId}
+
+cancelRemoteHostSession :: MonadUnliftIO m => RemoteHostSession -> m ()
+cancelRemoteHostSession = \case
+  RemoteHostSessionStarting {announcer} -> cancel announcer
+  RemoteHostSessionStarted {ctrlClient} -> liftIO $ HTTP2.closeHTTP2Client ctrlClient
 
 createRemoteHost :: (ChatMonad m) => m ChatResponse
 createRemoteHost = do
@@ -87,10 +129,7 @@ createRemoteHost = do
   ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) displayName
   storePath <- liftIO randomStorePath
   remoteHostId <- withStore' $ \db -> insertRemoteHost db storePath displayName caKey caCert
-  let oobData =
-        RemoteCtrlOOB
-          { caFingerprint = C.certificateFingerprint caCert
-          }
+  let oobData = RemoteCtrlOOB {caFingerprint = C.certificateFingerprint caCert}
   pure CRRemoteHostCreated {remoteHostId, oobData}
 
 -- | Generate a random 16-char filepath without / in it by using base64url encoding.
@@ -113,41 +152,40 @@ deleteRemoteHost remoteHostId = withRemoteHost remoteHostId $ \rh -> do
   pure CRRemoteHostDeleted {remoteHostId}
 
 processRemoteCommand :: (ChatMonad m) => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
-processRemoteCommand RemoteHostSessionStarting {} _ = error "TODO: sending remote commands before session started"
-processRemoteCommand RemoteHostSessionStarted {ctrlClient} (s, cmd) =
+processRemoteCommand RemoteHostSessionStarting {} _ = pure . CRChatError Nothing . ChatError $ CEInternalError "sending remote commands before session started"
+processRemoteCommand RemoteHostSessionStarted {ctrlClient} (s, cmd) = do
+  logDebug $ "processRemoteCommand: " <> T.pack (show s)
   -- XXX: intercept and filter some commands
   -- TODO: store missing files on remote host
   relayCommand ctrlClient s
 
 relayCommand :: (ChatMonad m) => HTTP2Client -> ByteString -> m ChatResponse
 relayCommand http s =
-  postBytestring Nothing http "/relay" mempty s >>= \case
-    Left e -> error "TODO: http2chatError"
+  postBytestring Nothing http "/send" mempty s >>= \case
+    Left e -> err $ "relayCommand/post: " <> show e
     Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
-      remoteChatResponse <-
-        if iTax
-          then case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
-            Left e -> error "TODO: json2chatError" e
-            Right (raw :: J.Value) -> case J.fromJSON (sum2tagged raw) of
-              J.Error e -> error "TODO: json2chatError" e
-              J.Success cr -> pure cr
-          else case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
-            Left e -> error "TODO: json2chatError" e
-            Right cr -> pure cr
+      logDebug $ "Got /send response: " <> T.pack (show bodyHead)
+      remoteChatResponse <- case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
+        Left e -> err $ "relayCommand/decodeValue: " <> show e
+        Right json -> case J.fromJSON $ toTaggedJSON json of
+          J.Error e -> err $ "relayCommand/fromJSON: " <> show e
+          J.Success cr -> pure cr
       case remoteChatResponse of
         -- TODO: intercept file responses and fetch files when needed
         -- XXX: is that even possible, to have a file response to a command?
         _ -> pure remoteChatResponse
   where
-    iTax = True -- TODO: get from RemoteHost
+    err = pure . CRChatError Nothing . ChatError . CEInternalError
+    toTaggedJSON :: J.Value -> J.Value
+    toTaggedJSON = id -- owsf2tagged TODO: get from RemoteHost
     -- XXX: extract to http2 transport
-    postBytestring timeout c path hs body = liftIO $ HTTP2.sendRequest c req timeout
+    postBytestring timeout' c path hs body = liftIO $ HTTP2.sendRequestDirect c req timeout'
       where
         req = HTTP2Client.requestBuilder "POST" path hs (Binary.fromByteString body)
 
 -- | Convert swift single-field sum encoding into tagged/discriminator-field
-sum2tagged :: J.Value -> J.Value
-sum2tagged = \case
+owsf2tagged :: J.Value -> J.Value
+owsf2tagged = \case
   J.Object todo'convert -> J.Object todo'convert
   skip -> skip
 
@@ -161,13 +199,13 @@ storeRemoteFile http localFile = do
   where
     postFile timeout c path hs file = liftIO $ do
       fileSize <- fromIntegral <$> getFileSize file
-      HTTP2.sendRequest c (req fileSize) timeout
+      HTTP2.sendRequestDirect c (req fileSize) timeout
       where
-        req size = HTTP2Client.requestFile "POST" path hs (HTTP2Client.FileSpec file 0 size)
+        req size = HTTP2Client.requestFile "PUT" path hs (HTTP2Client.FileSpec file 0 size)
 
 fetchRemoteFile :: (ChatMonad m) => HTTP2Client -> FilePath -> FileTransferId -> m ChatResponse
 fetchRemoteFile http storePath remoteFileId = do
-  liftIO (HTTP2.sendRequest http req Nothing) >>= \case
+  liftIO (HTTP2.sendRequestDirect http req Nothing) >>= \case
     Left e -> error "TODO: http2chatError"
     Right HTTP2.HTTP2Response {respBody} -> do
       error "TODO: stream body into a local file" -- XXX: consult headers for a file name?
@@ -175,47 +213,84 @@ fetchRemoteFile http storePath remoteFileId = do
     req = HTTP2Client.requestNoBody "GET" path mempty
     path = "/fetch/" <> bshow remoteFileId
 
-processControllerRequest :: (ChatMonad m) => RemoteCtrlId -> HTTP2.HTTP2Request -> m ()
-processControllerRequest rc req = error "TODO: processControllerRequest"
+processControllerRequest :: forall m . (ChatMonad m) => (ByteString -> m ChatResponse) -> HTTP2.HTTP2Request -> m ()
+processControllerRequest execChatCommand HTTP2.HTTP2Request {request, reqBody = HTTP2Body {bodyHead}, sendResponse} = do
+  logDebug $ "Remote controller request: " <> T.pack (show $ method <> " " <> path)
+  res <- tryChatError $ case (method, path) of
+    ("GET", "/") -> getHello
+    ("POST", "/send") -> sendCommand
+    ("GET", "/recv") -> recvMessage
+    ("PUT", "/store") -> storeFile
+    ("GET", "/fetch") -> fetchFile
+    unexpected -> respondWith Status.badRequest400 $ "unexpected method/path: " <> Binary.putStringUtf8 (show unexpected)
+  case res of
+    Left e -> logError $ "Error handling remote controller request: (" <> tshow (method <> " " <> path) <> "): " <> tshow e
+    Right () -> logDebug $ "Remote controller request: " <> tshow (method <> " " <> path) <> " OK"
+  where
+    method = fromMaybe "" $ HTTP2Server.requestMethod request
+    path = fromMaybe "" $ HTTP2Server.requestPath request
+    getHello = respond "OK"
+    sendCommand = execChatCommand bodyHead >>= respondJSON
+    recvMessage = chatReadVar remoteCtrlSession >>= \case
+      Nothing -> respondWith Status.internalServerError500 "session not active"
+      Just rcs -> atomically (readTBQueue $ remoteOutputQ rcs) >>= respondJSON
+    storeFile = respondWith Status.notImplemented501 "TODO: storeFile"
+    fetchFile = respondWith Status.notImplemented501 "TODO: fetchFile"
+
+    respondJSON :: J.ToJSON a => a -> m ()
+    respondJSON = respond . Binary.fromLazyByteString . J.encode
+
+    respond = respondWith Status.ok200
+    respondWith status = liftIO . sendResponse . HTTP2Server.responseBuilder status []
 
 -- * ChatRequest handlers
 
-startRemoteCtrl :: (ChatMonad m) => m ChatResponse
-startRemoteCtrl =
+startRemoteCtrl :: (ChatMonad m) => (ByteString -> m ChatResponse) -> m ChatResponse
+startRemoteCtrl execChatCommand =
   chatReadVar remoteCtrlSession >>= \case
     Just _busy -> throwError $ ChatErrorRemoteCtrl RCEBusy
     Nothing -> do
-      accepted <- newEmptyTMVarIO
+      size <- asks $ tbqSize . config
+      remoteOutputQ <- newTBQueueIO size
+      remoteNotifyQ <- newTBQueueIO size
       discovered <- newTVarIO mempty
       discoverer <- async $ discoverRemoteCtrls discovered
+      accepted <- newEmptyTMVarIO
       supervisor <- async $ do
         remoteCtrlId <- atomically (readTMVar accepted)
         withRemoteCtrl remoteCtrlId $ \RemoteCtrl {displayName, fingerprint} -> do
           source <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure
           toView $ CRRemoteCtrlConnecting {remoteCtrlId, displayName}
           atomically $ writeTVar discovered mempty -- flush unused sources
-          server <- async $ Discovery.connectRevHTTP2 source fingerprint (processControllerRequest remoteCtrlId)
+          server <- async $ Discovery.connectRevHTTP2 source fingerprint (processControllerRequest execChatCommand)
           chatModifyVar remoteCtrlSession $ fmap $ \s -> s {hostServer = Just server}
           toView $ CRRemoteCtrlConnected {remoteCtrlId, displayName}
           _ <- waitCatch server
           chatWriteVar remoteCtrlSession Nothing
-          toView $ CRRemoteCtrlStopped {remoteCtrlId}
-      chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted}
+          toView $ CRRemoteCtrlStopped Nothing
+      chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted, remoteOutputQ, remoteNotifyQ}
       pure $ CRRemoteCtrlStarted Nothing
 
 discoverRemoteCtrls :: (ChatMonad m) => TM.TMap C.KeyHash TransportHost -> m ()
-discoverRemoteCtrls discovered = Discovery.openListener >>= go
+discoverRemoteCtrls discovered = Discovery.withListener go
   where
     go sock =
       Discovery.recvAnnounce sock >>= \case
-        (SockAddrInet _port addr, invite) -> case strDecode invite of
+        (SockAddrInet _sockPort sockAddr, invite) -> case strDecode invite of
           Left _ -> go sock -- ignore malformed datagrams
           Right fingerprint -> do
-            atomically $ TM.insert fingerprint (THIPv4 $ hostAddressToTuple addr) discovered
+            let addr = THIPv4 (hostAddressToTuple sockAddr)
+            ifM
+              (atomically $ TM.member fingerprint discovered)
+              (logDebug $ "Fingerprint announce already knwon: " <> T.pack (show (addr, invite)))
+              (do
+                logInfo $ "New fingerprint announce: " <> T.pack (show (addr, invite))
+                atomically $ TM.insert fingerprint addr discovered
+              )
             withStore' (`getRemoteCtrlByFingerprint` fingerprint) >>= \case
-              Nothing -> toView $ CRRemoteCtrlAnnounce fingerprint -- unknown controller, ui action required
+              Nothing -> toView $ CRRemoteCtrlAnnounce fingerprint -- unknown controller, ui "register" action required
               Just found@RemoteCtrl {remoteCtrlId, accepted=storedChoice} -> case storedChoice of
-                Nothing -> toView $ CRRemoteCtrlFound found -- first-time controller, ui action required
+                Nothing -> toView $ CRRemoteCtrlFound found -- first-time controller, ui "accept" action required
                 Just False -> pure () -- skipping a rejected item
                 Just True -> chatReadVar remoteCtrlSession >>= \case
                   Nothing -> toView . CRChatError Nothing . ChatError $ CEInternalError "Remote host found without running a session"
@@ -258,20 +333,28 @@ rejectRemoteCtrl remoteCtrlId = do
       cancel supervisor
   pure $ CRRemoteCtrlRejected {remoteCtrlId}
 
-stopRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
-stopRemoteCtrl remoteCtrlId =
+stopRemoteCtrl :: (ChatMonad m) => m ChatResponse
+stopRemoteCtrl =
   chatReadVar remoteCtrlSession >>= \case
     Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
-    Just RemoteCtrlSession {discoverer, supervisor, hostServer} -> do
-      cancel discoverer -- may be gone by now
-      case hostServer of
-        Just host -> cancel host -- supervisor will clean up
-        Nothing -> do
-          cancel supervisor -- supervisor is blocked until session progresses
-          chatWriteVar remoteCtrlSession Nothing
-          toView $ CRRemoteCtrlStopped {remoteCtrlId}
+    Just rcs -> do
+      cancelRemoteCtrlSession rcs $ do
+        chatWriteVar remoteCtrlSession Nothing
+        toView $ CRRemoteCtrlStopped Nothing
       pure $ CRCmdOk Nothing
 
+cancelRemoteCtrlSession_ :: MonadUnliftIO m => RemoteCtrlSession -> m ()
+cancelRemoteCtrlSession_ rcs = cancelRemoteCtrlSession rcs $ pure ()
+
+cancelRemoteCtrlSession :: MonadUnliftIO m => RemoteCtrlSession -> m () -> m ()
+cancelRemoteCtrlSession RemoteCtrlSession {discoverer, supervisor, hostServer} cleanup = do
+  cancel discoverer -- may be gone by now
+  case hostServer of
+    Just host -> cancel host -- supervisor will clean up
+    Nothing -> do
+      cancel supervisor -- supervisor is blocked until session progresses
+      cleanup
+
 deleteRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
 deleteRemoteCtrl remoteCtrlId =
   chatReadVar remoteCtrlSession >>= \case
diff --git a/src/Simplex/Chat/Remote/Discovery.hs b/src/Simplex/Chat/Remote/Discovery.hs
index 2faed66cd..40314b4cb 100644
--- a/src/Simplex/Chat/Remote/Discovery.hs
+++ b/src/Simplex/Chat/Remote/Discovery.hs
@@ -12,6 +12,7 @@ module Simplex.Chat.Remote.Discovery
 
     -- * Discovery
     connectRevHTTP2,
+    withListener,
     openListener,
     recvAnnounce,
     connectTLSClient,
@@ -32,7 +33,7 @@ import Simplex.Messaging.Transport (supportedParameters)
 import qualified Simplex.Messaging.Transport as Transport
 import Simplex.Messaging.Transport.Client (TransportHost (..), defaultTransportClientConfig, runTransportClient)
 import Simplex.Messaging.Transport.HTTP2 (defaultHTTP2BufferSize, getHTTP2Body)
-import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError, attachHTTP2Client, defaultHTTP2ClientConfig)
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError, attachHTTP2Client, connTimeout, defaultHTTP2ClientConfig)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..), runHTTP2ServerWith)
 import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTransportServer)
 import Simplex.Messaging.Util (whenM)
@@ -52,15 +53,16 @@ pattern BROADCAST_PORT = "5226"
 -- | Announce tls server, wait for connection and attach http2 client to it.
 --
 -- Announcer is started when TLS server is started and stopped when a connection is made.
-announceRevHTTP2 :: (StrEncoding invite, MonadUnliftIO m) => IO () -> invite -> TLS.Credentials -> m (Either HTTP2ClientError HTTP2Client)
+announceRevHTTP2 :: (StrEncoding invite, MonadUnliftIO m) => m () -> invite -> TLS.Credentials -> m (Either HTTP2ClientError HTTP2Client)
 announceRevHTTP2 finishAction invite credentials = do
   httpClient <- newEmptyMVar
   started <- newEmptyTMVarIO
   finished <- newEmptyMVar
   announcer <- async . liftIO . whenM (atomically $ takeTMVar started) $ runAnnouncer (strEncode invite)
   tlsServer <- startTLSServer started credentials $ \tls -> cancel announcer >> runHTTP2Client finished httpClient tls
-  _ <- forkIO . liftIO $ do
+  _ <- forkIO $ do
     readMVar finished
+    cancel announcer
     cancel tlsServer
     finishAction
   readMVar httpClient
@@ -68,11 +70,12 @@ announceRevHTTP2 finishAction invite credentials = do
 -- | Broadcast invite with link-local datagrams
 runAnnouncer :: ByteString -> IO ()
 runAnnouncer inviteBS = do
-  sock <- UDP.clientSocket BROADCAST_ADDR_V4 BROADCAST_PORT False
-  N.setSocketOption (UDP.udpSocket sock) N.Broadcast 1
-  forever $ do
-    UDP.send sock inviteBS
-    threadDelay 1000000
+  bracket (UDP.clientSocket BROADCAST_ADDR_V4 BROADCAST_PORT False) UDP.close $ \sock -> do
+    N.setSocketOption (UDP.udpSocket sock) N.Broadcast 1
+    N.setSocketOption (UDP.udpSocket sock) N.ReuseAddr 1
+    forever $ do
+      UDP.send sock inviteBS
+      threadDelay 1000000
 
 startTLSServer :: (MonadUnliftIO m) => TMVar Bool -> TLS.Credentials -> (Transport.TLS -> IO ()) -> m (Async ())
 startTLSServer started credentials = async . liftIO . runTransportServer started BROADCAST_PORT serverParams defaultTransportServerConfig
@@ -88,8 +91,13 @@ startTLSServer started credentials = async . liftIO . runTransportServer started
 -- | Attach HTTP2 client and hold the TLS until the attached client finishes.
 runHTTP2Client :: MVar () -> MVar (Either HTTP2ClientError HTTP2Client) -> Transport.TLS -> IO ()
 runHTTP2Client finishedVar clientVar tls = do
-  attachHTTP2Client defaultHTTP2ClientConfig ANY_ADDR_V4 BROADCAST_PORT (putMVar finishedVar ()) defaultHTTP2BufferSize tls >>= putMVar clientVar
+  attachHTTP2Client config ANY_ADDR_V4 BROADCAST_PORT (putMVar finishedVar ()) defaultHTTP2BufferSize tls >>= putMVar clientVar
   readMVar finishedVar
+  where
+    config = defaultHTTP2ClientConfig { connTimeout = 86400000000 }
+
+withListener :: (MonadUnliftIO m) => (UDP.ListenSocket -> m a) -> m a
+withListener = bracket openListener (liftIO . UDP.stop)
 
 openListener :: (MonadIO m) => m UDP.ListenSocket
 openListener = liftIO $ do
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index f13c3c84e..cdff2b7ac 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -5,15 +5,10 @@
 
 module Simplex.Chat.Remote.Types where
 
-import Control.Concurrent.Async (Async)
 import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.TMap (TMap)
-import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
-import UnliftIO.STM
 
 type RemoteHostId = Int64
 
@@ -40,22 +35,3 @@ data RemoteCtrl = RemoteCtrl
   deriving (Show)
 
 $(J.deriveJSON J.defaultOptions ''RemoteCtrl)
-
-data RemoteHostSession
-  = RemoteHostSessionStarting
-      { announcer :: Async ()
-      }
-  | RemoteHostSessionStarted
-      { -- | Path for local resources to be synchronized with host
-        storePath :: FilePath,
-        ctrlClient :: HTTP2Client
-      }
-
-data RemoteCtrlSession = RemoteCtrlSession
-  { -- | Server side of transport to process remote commands and forward notifications
-    discoverer :: Async (),
-    supervisor :: Async (),
-    hostServer :: Maybe (Async ()),
-    discovered :: TMap C.KeyHash TransportHost,
-    accepted :: TMVar RemoteCtrlId
-  }
diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs
index 1097a7954..4a73a0fd7 100644
--- a/src/Simplex/Chat/Terminal/Input.hs
+++ b/src/Simplex/Chat/Terminal/Input.hs
@@ -53,15 +53,16 @@ getKey =
 runInputLoop :: ChatTerminal -> ChatController -> IO ()
 runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
   s <- atomically . readTBQueue $ inputQ cc
+  rh <- readTVarIO $ currentRemoteHost cc
   let bs = encodeUtf8 $ T.pack s
       cmd = parseChatCommand bs
   unless (isMessage cmd) $ echo s
-  r <- runReaderT (execChatCommand Nothing bs) cc
+  r <- runReaderT (execChatCommand rh bs) cc
   case r of
     CRChatCmdError _ _ -> when (isMessage cmd) $ echo s
     CRChatError _ _ -> when (isMessage cmd) $ echo s
     _ -> pure ()
-  printRespToTerminal ct cc False r
+  printRespToTerminal ct cc False rh r
   startLiveMessage cmd r
   where
     echo s = printToTerminal ct [plain s]
@@ -134,7 +135,7 @@ runTerminalInput ct cc = withChatTerm ct $ do
   receiveFromTTY cc ct
 
 receiveFromTTY :: forall m. MonadTerminal m => ChatController -> ChatTerminal -> m ()
-receiveFromTTY cc@ChatController {inputQ, activeTo, currentUser, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState} =
+receiveFromTTY cc@ChatController {inputQ, activeTo, currentUser, currentRemoteHost, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState} =
   forever $ getKey >>= liftIO . processKey >> withTermLock ct (updateInput ct)
   where
     processKey :: (Key, Modifiers) -> IO ()
@@ -166,7 +167,8 @@ receiveFromTTY cc@ChatController {inputQ, activeTo, currentUser, chatStore} ct@C
       kill promptThreadId
       atomically $ writeTVar liveMessageState Nothing
       r <- sendUpdatedLiveMessage cc sentMsg lm False
-      printRespToTerminal ct cc False r
+      rh <- readTVarIO currentRemoteHost -- XXX: should be inherited from live message state
+      printRespToTerminal ct cc False rh r
       where
         kill sel = deRefWeak (sel lm) >>= mapM_ killThread
 
diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs
index 74bb9e8c0..e6792129c 100644
--- a/src/Simplex/Chat/Terminal/Output.hs
+++ b/src/Simplex/Chat/Terminal/Output.hs
@@ -21,6 +21,7 @@ import Simplex.Chat.Controller
 import Simplex.Chat.Messages hiding (NewChatItem (..))
 import Simplex.Chat.Styled
 import Simplex.Chat.View
+import Simplex.Chat.Remote.Types (RemoteHostId)
 import System.Console.ANSI.Types
 import System.IO (IOMode (..), hPutStrLn, withFile)
 import System.Mem.Weak (Weak)
@@ -112,7 +113,7 @@ withTermLock ChatTerminal {termLock} action = do
 runTerminalOutput :: ChatTerminal -> ChatController -> IO ()
 runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = do
   forever $ do
-    (_, _, r) <- atomically $ readTBQueue outputQ
+    (_, outputRH, r) <- atomically $ readTBQueue outputQ
     case r of
       CRNewChatItem _ ci -> markChatItemRead ci
       CRChatItemUpdated _ ci -> markChatItemRead ci
@@ -121,7 +122,7 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = d
           Just path -> if logResponseToFile r then logResponse path else printToTerminal ct
           _ -> printToTerminal ct
     liveItems <- readTVarIO showLiveItems
-    responseString cc liveItems r >>= printResp
+    responseString cc liveItems outputRH r >>= printResp
   where
     markChatItemRead (AChatItem _ _ chat item@ChatItem {chatDir, meta = CIMeta {itemStatus}}) =
       case (muted chat chatDir, itemStatus) of
@@ -132,15 +133,16 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = d
         _ -> pure ()
     logResponse path s = withFile path AppendMode $ \h -> mapM_ (hPutStrLn h . unStyle) s
 
-printRespToTerminal :: ChatTerminal -> ChatController -> Bool -> ChatResponse -> IO ()
-printRespToTerminal ct cc liveItems r = responseString cc liveItems r >>= printToTerminal ct
+printRespToTerminal :: ChatTerminal -> ChatController -> Bool -> Maybe RemoteHostId -> ChatResponse -> IO ()
+printRespToTerminal ct cc liveItems outputRH r = responseString cc liveItems outputRH r >>= printToTerminal ct
 
-responseString :: ChatController -> Bool -> ChatResponse -> IO [StyledString]
-responseString cc liveItems r = do
-  user <- readTVarIO $ currentUser cc
+responseString :: ChatController -> Bool -> Maybe RemoteHostId -> ChatResponse -> IO [StyledString]
+responseString cc liveItems outputRH r = do
+  currentRH <- readTVarIO $ currentRemoteHost cc
+  user <- readTVarIO $ currentUser cc -- XXX: local user, should be subsumed by remote when connected
   ts <- getCurrentTime
   tz <- getCurrentTimeZone
-  pure $ responseToView user (config cc) liveItems ts tz r
+  pure $ responseToView (currentRH, user) (config cc) liveItems ts tz outputRH r
 
 printToTerminal :: ChatTerminal -> [StyledString] -> IO ()
 printToTerminal ct s =
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index 088f23e05..03e0135e7 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -1442,6 +1442,7 @@ serializeIntroStatus = \case
   GMIntroConnected -> "con"
 
 data Notification = Notification {title :: Text, text :: Text}
+  deriving (Show, Generic, FromJSON, ToJSON)
 
 textParseJSON :: TextEncoding a => String -> J.Value -> JT.Parser a
 textParseJSON name = J.withText name $ maybe (fail $ "bad " <> name) pure . textDecode
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index f32b1835e..f98406d1b 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -66,11 +66,11 @@ import System.Console.ANSI.Types
 
 type CurrentTime = UTCTime
 
-serializeChatResponse :: Maybe User -> CurrentTime -> TimeZone -> ChatResponse -> String
-serializeChatResponse user_ ts tz = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz
+serializeChatResponse :: (Maybe RemoteHostId, Maybe User) -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> String
+serializeChatResponse user_ ts tz remoteHost_ = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz remoteHost_
 
-responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> ChatResponse -> [StyledString]
-responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz = \case
+responseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> [StyledString]
+responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz outputRH = \case
   CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
   CRUsersList users -> viewUsersList users
   CRChatStarted _ -> ["chat started"]
@@ -274,7 +274,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
   CRRemoteCtrlRejected rcId -> ["remote controller " <> sShow rcId <> " rejected"]
   CRRemoteCtrlConnecting rcId rcName -> ["remote controller " <> sShow rcId <> " connecting to " <> plain rcName]
   CRRemoteCtrlConnected rcId rcName -> ["remote controller " <> sShow rcId <> " connected, " <> plain rcName]
-  CRRemoteCtrlStopped rcId -> ["remote controller " <> sShow rcId <> " stopped"]
+  CRRemoteCtrlStopped _ -> ["remote controller stopped"]
   CRRemoteCtrlDeleted rcId -> ["remote controller " <> sShow rcId <> " deleted"]
   CRSQLResult rows -> map plain rows
   CRSlowSQLQueries {chatQueries, agentQueries} ->
@@ -323,12 +323,14 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
       | otherwise = []
     ttyUserPrefix :: User -> [StyledString] -> [StyledString]
     ttyUserPrefix _ [] = []
-    ttyUserPrefix User {userId, localDisplayName = u} ss = prependFirst userPrefix ss
+    ttyUserPrefix User {userId, localDisplayName = u} ss = prependFirst prefix ss
       where
-        userPrefix = case user_ of
-          Just User {userId = activeUserId} -> if userId /= activeUserId then prefix else ""
-          _ -> prefix
-        prefix = "[user: " <> highlight u <> "] "
+        prefix = if outputRH /= currentRH then r else userPrefix
+        r = case outputRH of
+          Nothing -> "[local] " <> userPrefix
+          Just rh -> "[remote: ]" <> highlight (show rh) <> "] "
+        userPrefix = if Just userId /= currentUserId then "[user: " <> highlight u <> "] " else ""
+        currentUserId = fmap (\User {userId} -> userId) user_
     ttyUser' :: Maybe User -> [StyledString] -> [StyledString]
     ttyUser' = maybe id ttyUser
     ttyUserPrefix' :: Maybe User -> [StyledString] -> [StyledString]
diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs
index 6831cf319..107faef72 100644
--- a/tests/ChatTests/Utils.hs
+++ b/tests/ChatTests/Utils.hs
@@ -34,6 +34,9 @@ import Test.Hspec
 defaultPrefs :: Maybe Preferences
 defaultPrefs = Just $ toChatPrefs defaultChatPrefs
 
+aliceDesktopProfile :: Profile
+aliceDesktopProfile = Profile {displayName = "alice_desktop", fullName = "Alice Desktop", image = Nothing, contactLink = Nothing, preferences = defaultPrefs}
+
 aliceProfile :: Profile
 aliceProfile = Profile {displayName = "alice", fullName = "Alice", image = Nothing, contactLink = Nothing, preferences = defaultPrefs}
 
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index d1c162187..f9137cdba 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -31,7 +31,8 @@ remoteTests :: SpecWith FilePath
 remoteTests = describe "Handshake" $ do
   it "generates usable credentials" genCredentialsTest
   it "connects announcer with discoverer over reverse-http2" announceDiscoverHttp2Test
-  it "connects desktop and mobile" remoteHandshakeTest
+  xit "connects desktop and mobile" remoteHandshakeTest
+  it "send messages via remote desktop" remoteCommandTest
 
 -- * Low-level TLS with ephemeral credentials
 
@@ -39,11 +40,10 @@ genCredentialsTest :: (HasCallStack) => FilePath -> IO ()
 genCredentialsTest _tmp = do
   (fingerprint, credentials) <- genTestCredentials
   started <- newEmptyTMVarIO
-  server <- Discovery.startTLSServer started credentials serverHandler
-  ok <- atomically (readTMVar started)
-  unless ok $ cancel server >> error "TLS server failed to start"
-  Discovery.connectTLSClient "127.0.0.1" fingerprint clientHandler
-  cancel server
+  bracket (Discovery.startTLSServer started credentials serverHandler) cancel $ \_server -> do
+    ok <- atomically (readTMVar started)
+    unless ok $ error "TLS server failed to start"
+    Discovery.connectTLSClient "127.0.0.1" fingerprint clientHandler
   where
     serverHandler serverTls = do
       traceM "    - Sending from server"
@@ -62,19 +62,21 @@ announceDiscoverHttp2Test :: (HasCallStack) => FilePath -> IO ()
 announceDiscoverHttp2Test _tmp = do
   (fingerprint, credentials) <- genTestCredentials
   finished <- newEmptyMVar
-  announcer <- async $ do
+  controller <- async $ do
     traceM "    - Controller: starting"
-    http <- Discovery.announceRevHTTP2 (putMVar finished ()) fingerprint credentials >>= either (fail . show) pure
-    traceM "    - Controller: got client"
-    sendRequest http (C.requestNoBody "GET" "/" []) (Just 10000000) >>= \case
-      Left err -> do
-        traceM "    - Controller: got error"
-        fail $ show err
-      Right HTTP2Response {} ->
-        traceM "    - Controller: got response"
-    closeHTTP2Client http
-  dis <- async $ do
-    sock <- Discovery.openListener
+    bracket
+      (Discovery.announceRevHTTP2 (putMVar finished ()) fingerprint credentials >>= either (fail . show) pure)
+      closeHTTP2Client
+      ( \http -> do
+          traceM "    - Controller: got client"
+          sendRequest http (C.requestNoBody "GET" "/" []) (Just 10000000) >>= \case
+            Left err -> do
+              traceM "    - Controller: got error"
+              fail $ show err
+            Right HTTP2Response {} ->
+              traceM "    - Controller: got response"
+      )
+  host <- async $ Discovery.withListener $ \sock -> do
     (N.SockAddrInet _port addr, invite) <- Discovery.recvAnnounce sock
     strDecode invite `shouldBe` Right fingerprint
     traceM "    - Host: connecting"
@@ -84,14 +86,13 @@ announceDiscoverHttp2Test _tmp = do
         traceM "    - Host: got request"
         sendResponse $ S.responseNoBody ok200 []
         traceM "    - Host: sent response"
-    takeMVar finished
-    cancel server
+    takeMVar finished `finally` cancel server
     traceM "    - Host: finished"
-  waitBoth dis announcer `shouldReturn` ((), ())
+  (waitBoth host controller `shouldReturn` ((), ())) `onException` (cancel host >> cancel controller)
 
 -- * Chat commands
 
-remoteHandshakeTest :: HasCallStack => FilePath -> IO ()
+remoteHandshakeTest :: (HasCallStack) => FilePath -> IO ()
 remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   desktop ##> "/list remote hosts"
   desktop <## "No remote hosts"
@@ -103,7 +104,6 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   desktop ##> "/list remote hosts"
   desktop <## "Remote hosts:"
   desktop <## "1. TODO" -- TODO host name probably should be Maybe, as when host is created there is no name yet
-
   desktop ##> "/start remote host 1"
   desktop <## "remote host 1 started"
 
@@ -124,9 +124,9 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   mobile <## "remote controller 1 accepted" -- alternative scenario: accepted before controller start
   mobile <## "remote controller 1 connecting to TODO"
   mobile <## "remote controller 1 connected, TODO"
-  mobile ##> "/stop remote ctrl 1"
+  mobile ##> "/stop remote ctrl"
   mobile <## "ok"
-  mobile <## "remote controller 1 stopped" -- TODO two outputs
+  mobile <## "remote controller stopped"
   mobile ##> "/delete remote ctrl 1"
   mobile <## "remote controller 1 deleted"
   mobile ##> "/list remote ctrls"
@@ -139,6 +139,56 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   desktop ##> "/list remote hosts"
   desktop <## "No remote hosts"
 
+remoteCommandTest :: (HasCallStack) => FilePath -> IO ()
+remoteCommandTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
+  desktop ##> "/create remote host"
+  desktop <## "remote host 1 created"
+  desktop <## "connection code:"
+  fingerprint <- getTermLine desktop
+
+  desktop ##> "/start remote host 1"
+  desktop <## "remote host 1 started"
+
+  mobile ##> "/start remote ctrl"
+  mobile <## "remote controller started"
+  mobile <## "remote controller announced"
+  mobile <## "connection code:"
+  fingerprint' <- getTermLine mobile
+  fingerprint' `shouldBe` fingerprint
+  mobile ##> ("/register remote ctrl " <> fingerprint')
+  mobile <## "remote controller 1 registered"
+  mobile ##> "/accept remote ctrl 1"
+  mobile <## "remote controller 1 accepted" -- alternative scenario: accepted before controller start
+  mobile <## "remote controller 1 connecting to TODO"
+  mobile <## "remote controller 1 connected, TODO"
+  desktop <## "remote host 1 connected"
+
+  traceM "    - exchanging contacts"
+  bob ##> "/c"
+  inv' <- getInvitation bob
+  desktop ##> ("/c " <> inv')
+  desktop <## "confirmation sent!"
+  concurrently_
+    (desktop <## "bob (Bob): contact is connected")
+    (bob <## "alice (Alice): contact is connected")
+
+  traceM "    - sending messages"
+  desktop #> "@bob hello there 🙂"
+  bob <# "alice> hello there 🙂"
+  bob #> "@alice hi"
+  desktop <# "bob> hi"
+
+  traceM "    - post-remote checks"
+  mobile ##> "/stop remote ctrl"
+  mobile <## "ok"
+  concurrently_
+    (mobile <## "remote controller stopped")
+    (desktop <## "remote host 1 stopped")
+  mobile ##> "/contacts"
+  mobile <## "bob (Bob)"
+
+  traceM "    - done"
+
 -- * Utils
 
 genTestCredentials :: IO (C.KeyHash, TLS.Credentials)

From 6f5ba54f7b96e85a6b59d0522e4d6b71754e2f48 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Wed, 11 Oct 2023 11:45:05 +0300
Subject: [PATCH 10/69] core: remote session files (#3189)

* Receiving files on CRRcvFileComplete

* Add remote /fr test

* Add broken startFileTransfer notice

* Sending files with SendFile/SendImage

With tests for SendFile.

* Add APISendMessage handling

* Test file preconditions

No files should be in stores before actual sending.

* Fix mobile paths in storeFile
---
 src/Simplex/Chat/Remote.hs | 218 +++++++++++++++++++++++++++----------
 tests/RemoteTests.hs       |  92 ++++++++++++++++
 2 files changed, 255 insertions(+), 55 deletions(-)

diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 722274335..0f03c1fdb 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
@@ -16,36 +17,47 @@ import Control.Monad.Reader (asks)
 import Control.Monad.STM (retry)
 import Crypto.Random (getRandomBytes)
 import qualified Data.Aeson as J
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.Binary.Builder as Binary
-import Data.ByteString (ByteString)
+import Data.ByteString (ByteString, hPut)
 import qualified Data.ByteString.Base64.URL as B64U
 import qualified Data.ByteString.Char8 as B
+import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
-import Data.Maybe (fromMaybe)
 import qualified Data.Map.Strict as M
+import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import qualified Network.HTTP.Types as HTTP
 import qualified Network.HTTP.Types.Status as Status
 import qualified Network.HTTP2.Client as HTTP2Client
 import qualified Network.HTTP2.Server as HTTP2Server
 import Network.Socket (SockAddr (..), hostAddressToTuple)
 import Simplex.Chat.Controller
+import Simplex.Chat.Messages (AChatItem (..), CIFile (..), CIFileStatus (..), ChatItem (..), chatNameStr)
+import Simplex.Chat.Messages.CIContent (MsgDirection (..), SMsgDirection (..))
 import qualified Simplex.Chat.Remote.Discovery as Discovery
 import Simplex.Chat.Remote.Types
+import Simplex.Chat.Store.Files (getRcvFileTransfer)
+import Simplex.Chat.Store.Profiles (getUser)
 import Simplex.Chat.Store.Remote
+import Simplex.Chat.Store.Shared (StoreError (..))
 import Simplex.Chat.Types
+import Simplex.FileTransfer.Util (uniqueCombine)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
-import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
+import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), defaultHTTP2BufferSize)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HTTP2
 import qualified Simplex.Messaging.Transport.HTTP2.Server as HTTP2
 import Simplex.Messaging.Util (bshow, ifM, tshow)
-import System.Directory (getFileSize)
+import System.FilePath (isPathSeparator, takeFileName, (</>))
 import UnliftIO
+import UnliftIO.Directory (createDirectoryIfMissing, getFileSize, makeAbsolute)
 
 withRemoteHostSession :: (ChatMonad m) => RemoteHostId -> (RemoteHostSession -> m a) -> m a
 withRemoteHostSession remoteHostId action = do
@@ -90,7 +102,15 @@ startRemoteHost remoteHostId = do
               cleanup finished
             Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
               logDebug $ "Got initial from remote host: " <> tshow bodyHead
-              _ <- asks outputQ >>= async . pollRemote finished ctrlClient "/recv" (Nothing, Just remoteHostId,)
+              oq <- asks outputQ
+              let toViewRemote = atomically . writeTBQueue oq . (Nothing,Just remoteHostId,)
+              void . async $ pollRemote finished ctrlClient "/recv" $ \chatResponse -> do
+                case chatResponse of
+                  CRRcvFileComplete {user = ru, chatItem = AChatItem c d@SMDRcv i ci@ChatItem {file = Just ciFile}} -> do
+                    handleRcvFileComplete ctrlClient storePath ru ciFile >>= \case
+                      Nothing -> toViewRemote chatResponse
+                      Just localFile -> toViewRemote CRRcvFileComplete {user = ru, chatItem = AChatItem c d i ci {file = Just localFile}}
+                  _ -> toViewRemote chatResponse
               toView CRRemoteHostConnected {remoteHostId}
 
 sendHello :: (ChatMonad m) => HTTP2Client -> m (Either HTTP2.HTTP2ClientError HTTP2.HTTP2Response)
@@ -98,16 +118,17 @@ sendHello http = liftIO (HTTP2.sendRequestDirect http req Nothing)
   where
     req = HTTP2Client.requestNoBody "GET" "/" mempty
 
-pollRemote :: (ChatMonad m, J.FromJSON a) => TVar Bool -> HTTP2Client -> ByteString -> (a -> b) -> TBQueue b -> m ()
-pollRemote finished http path f queue = loop
+pollRemote :: (ChatMonad m, J.FromJSON a) => TVar Bool -> HTTP2Client -> ByteString -> (a -> m ()) -> m ()
+pollRemote finished http path action = loop
   where
     loop = do
       liftIO (HTTP2.sendRequestDirect http req Nothing) >>= \case
         Left e -> logError $ "pollRemote: " <> tshow (path, e)
-        Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} ->
+        Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
+          logDebug $ "Got /recv response: " <> decodeUtf8 bodyHead
           case J.eitherDecodeStrict' bodyHead of
             Left e -> logError $ "pollRemote/decode: " <> tshow (path, e)
-            Right o -> atomically $ writeTBQueue queue (f o)
+            Right o -> action o
       readTVarIO finished >>= (`unless` loop)
     req = HTTP2Client.requestNoBody "GET" path mempty
 
@@ -118,7 +139,7 @@ closeRemoteHostSession remoteHostId = withRemoteHostSession remoteHostId $ \sess
   chatModifyVar remoteHostSessions $ M.delete remoteHostId
   pure CRRemoteHostStopped {remoteHostId}
 
-cancelRemoteHostSession :: MonadUnliftIO m => RemoteHostSession -> m ()
+cancelRemoteHostSession :: (MonadUnliftIO m) => RemoteHostSession -> m ()
 cancelRemoteHostSession = \case
   RemoteHostSessionStarting {announcer} -> cancel announcer
   RemoteHostSessionStarted {ctrlClient} -> liftIO $ HTTP2.closeHTTP2Client ctrlClient
@@ -154,17 +175,31 @@ deleteRemoteHost remoteHostId = withRemoteHost remoteHostId $ \rh -> do
 processRemoteCommand :: (ChatMonad m) => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
 processRemoteCommand RemoteHostSessionStarting {} _ = pure . CRChatError Nothing . ChatError $ CEInternalError "sending remote commands before session started"
 processRemoteCommand RemoteHostSessionStarted {ctrlClient} (s, cmd) = do
-  logDebug $ "processRemoteCommand: " <> T.pack (show s)
-  -- XXX: intercept and filter some commands
-  -- TODO: store missing files on remote host
-  relayCommand ctrlClient s
+  logDebug $ "processRemoteCommand: " <> tshow (s, cmd)
+  case cmd of
+    SendFile cn ctrlPath -> do
+      storeRemoteFile ctrlClient ctrlPath >>= \case
+        -- TODO: use Left
+        Nothing -> pure . CRChatError Nothing . ChatError $ CEInternalError "failed to store file on remote host"
+        Just hostPath -> relayCommand ctrlClient $ "/file " <> utf8String (chatNameStr cn) <> " " <> utf8String hostPath
+    SendImage cn ctrlPath -> do
+      storeRemoteFile ctrlClient ctrlPath >>= \case
+        Nothing -> pure . CRChatError Nothing . ChatError $ CEInternalError "failed to store image on remote host"
+        Just hostPath -> relayCommand ctrlClient $ "/image " <> utf8String (chatNameStr cn) <> " " <> utf8String hostPath
+    APISendMessage {composedMessage = cm@ComposedMessage {fileSource = Just CryptoFile {filePath = ctrlPath, cryptoArgs}}} -> do
+      storeRemoteFile ctrlClient ctrlPath >>= \case
+        Nothing -> pure . CRChatError Nothing . ChatError $ CEInternalError "failed to store file on remote host"
+        Just hostPath -> do
+          let cm' = cm {fileSource = Just CryptoFile {filePath = hostPath, cryptoArgs}} :: ComposedMessage
+          relayCommand ctrlClient $ B.takeWhile (/= '{') s <> B.toStrict (J.encode cm')
+    _ -> relayCommand ctrlClient s
 
 relayCommand :: (ChatMonad m) => HTTP2Client -> ByteString -> m ChatResponse
 relayCommand http s =
   postBytestring Nothing http "/send" mempty s >>= \case
     Left e -> err $ "relayCommand/post: " <> show e
     Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
-      logDebug $ "Got /send response: " <> T.pack (show bodyHead)
+      logDebug $ "Got /send response: " <> decodeUtf8 bodyHead
       remoteChatResponse <- case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
         Left e -> err $ "relayCommand/decodeValue: " <> show e
         Right json -> case J.fromJSON $ toTaggedJSON json of
@@ -183,61 +218,129 @@ relayCommand http s =
       where
         req = HTTP2Client.requestBuilder "POST" path hs (Binary.fromByteString body)
 
+handleRcvFileComplete :: (ChatMonad m) => HTTP2Client -> FilePath -> User -> CIFile 'MDRcv -> m (Maybe (CIFile 'MDRcv))
+handleRcvFileComplete http storePath remoteUser cif@CIFile {fileId, fileName, fileStatus} = case fileStatus of
+  CIFSRcvComplete ->
+    chatReadVar filesFolder >>= \case
+      Just baseDir -> do
+        let hostStore = baseDir </> storePath
+        createDirectoryIfMissing True hostStore
+        localPath <- uniqueCombine hostStore fileName
+        ok <- fetchRemoteFile http remoteUser fileId localPath
+        pure $ Just (cif {fileName = localPath} :: CIFile 'MDRcv)
+      Nothing -> Nothing <$ logError "Local file store not available while fetching remote file"
+  _ -> Nothing <$ logDebug ("Ingoring invalid file notification for file (" <> tshow fileId <> ") " <> tshow fileName)
+
 -- | Convert swift single-field sum encoding into tagged/discriminator-field
 owsf2tagged :: J.Value -> J.Value
 owsf2tagged = \case
   J.Object todo'convert -> J.Object todo'convert
   skip -> skip
 
-storeRemoteFile :: (ChatMonad m) => HTTP2Client -> FilePath -> m ChatResponse
+storeRemoteFile :: (MonadUnliftIO m) => HTTP2Client -> FilePath -> m (Maybe FilePath)
 storeRemoteFile http localFile = do
-  postFile Nothing http "/store" mempty localFile >>= \case
-    Left todo'err -> error "TODO: http2chatError"
-    Right HTTP2.HTTP2Response {response} -> case HTTP.statusCode <$> HTTP2Client.responseStatus response of
-      Just 200 -> pure $ CRCmdOk Nothing
-      todo'notOk -> error "TODO: http2chatError"
+  putFile Nothing http uri mempty localFile >>= \case
+    Left h2ce -> Nothing <$ logError (tshow h2ce)
+    Right HTTP2.HTTP2Response {response, respBody = HTTP2Body {bodyHead}} ->
+      case HTTP.statusCode <$> HTTP2Client.responseStatus response of
+        Just 200 -> pure . Just $ B.unpack bodyHead
+        notOk -> Nothing <$ logError ("Bad response status: " <> tshow notOk)
   where
-    postFile timeout c path hs file = liftIO $ do
+    uri = "/store?" <> HTTP.renderSimpleQuery False [("file_name", utf8String $ takeFileName localFile)]
+    putFile timeout c path hs file = liftIO $ do
       fileSize <- fromIntegral <$> getFileSize file
       HTTP2.sendRequestDirect c (req fileSize) timeout
       where
         req size = HTTP2Client.requestFile "PUT" path hs (HTTP2Client.FileSpec file 0 size)
 
-fetchRemoteFile :: (ChatMonad m) => HTTP2Client -> FilePath -> FileTransferId -> m ChatResponse
-fetchRemoteFile http storePath remoteFileId = do
+fetchRemoteFile :: (MonadUnliftIO m) => HTTP2Client -> User -> Int64 -> FilePath -> m Bool
+fetchRemoteFile http User {userId = remoteUserId} remoteFileId localPath = do
   liftIO (HTTP2.sendRequestDirect http req Nothing) >>= \case
-    Left e -> error "TODO: http2chatError"
-    Right HTTP2.HTTP2Response {respBody} -> do
-      error "TODO: stream body into a local file" -- XXX: consult headers for a file name?
+    Left h2ce -> False <$ logError (tshow h2ce)
+    Right HTTP2.HTTP2Response {response, respBody} ->
+      if HTTP2Client.responseStatus response == Just Status.ok200
+        then True <$ writeBodyToFile localPath respBody
+        else False <$ (logError $ "Request failed: " <> maybe "(??)" tshow (HTTP2Client.responseStatus response) <> " " <> decodeUtf8 (bodyHead respBody))
   where
     req = HTTP2Client.requestNoBody "GET" path mempty
-    path = "/fetch/" <> bshow remoteFileId
+    path = "/fetch?" <> HTTP.renderSimpleQuery False [("user_id", bshow remoteUserId), ("file_id", bshow remoteFileId)]
 
-processControllerRequest :: forall m . (ChatMonad m) => (ByteString -> m ChatResponse) -> HTTP2.HTTP2Request -> m ()
-processControllerRequest execChatCommand HTTP2.HTTP2Request {request, reqBody = HTTP2Body {bodyHead}, sendResponse} = do
-  logDebug $ "Remote controller request: " <> T.pack (show $ method <> " " <> path)
-  res <- tryChatError $ case (method, path) of
-    ("GET", "/") -> getHello
-    ("POST", "/send") -> sendCommand
-    ("GET", "/recv") -> recvMessage
-    ("PUT", "/store") -> storeFile
-    ("GET", "/fetch") -> fetchFile
+-- XXX: extract to Transport.HTTP2 ?
+writeBodyToFile :: (MonadUnliftIO m) => FilePath -> HTTP2Body -> m ()
+writeBodyToFile path HTTP2Body {bodyHead, bodySize, bodyPart} = do
+  logInfo $ "Receiving " <> tshow bodySize <> " bytes to " <> tshow path
+  liftIO . withFile path WriteMode $ \h -> do
+    hPut h bodyHead
+    mapM_ (hPutBodyChunks h) bodyPart
+
+hPutBodyChunks :: Handle -> (Int -> IO ByteString) -> IO ()
+hPutBodyChunks h getChunk = do
+  chunk <- getChunk defaultHTTP2BufferSize
+  unless (B.null chunk) $ do
+    hPut h chunk
+    hPutBodyChunks h getChunk
+
+processControllerRequest :: forall m. (ChatMonad m) => (ByteString -> m ChatResponse) -> HTTP2.HTTP2Request -> m ()
+processControllerRequest execChatCommand HTTP2.HTTP2Request {request, reqBody, sendResponse} = do
+  logDebug $ "Remote controller request: " <> tshow (method <> " " <> path)
+  res <- tryChatError $ case (method, ps) of
+    ("GET", []) -> getHello
+    ("POST", ["send"]) -> sendCommand
+    ("GET", ["recv"]) -> recvMessage
+    ("PUT", ["store"]) -> storeFile
+    ("GET", ["fetch"]) -> fetchFile
     unexpected -> respondWith Status.badRequest400 $ "unexpected method/path: " <> Binary.putStringUtf8 (show unexpected)
   case res of
     Left e -> logError $ "Error handling remote controller request: (" <> tshow (method <> " " <> path) <> "): " <> tshow e
     Right () -> logDebug $ "Remote controller request: " <> tshow (method <> " " <> path) <> " OK"
   where
     method = fromMaybe "" $ HTTP2Server.requestMethod request
-    path = fromMaybe "" $ HTTP2Server.requestPath request
+    path = fromMaybe "/" $ HTTP2Server.requestPath request
+    (ps, query) = HTTP.decodePath path
     getHello = respond "OK"
-    sendCommand = execChatCommand bodyHead >>= respondJSON
-    recvMessage = chatReadVar remoteCtrlSession >>= \case
-      Nothing -> respondWith Status.internalServerError500 "session not active"
-      Just rcs -> atomically (readTBQueue $ remoteOutputQ rcs) >>= respondJSON
-    storeFile = respondWith Status.notImplemented501 "TODO: storeFile"
-    fetchFile = respondWith Status.notImplemented501 "TODO: fetchFile"
+    sendCommand = execChatCommand (bodyHead reqBody) >>= respondJSON
+    recvMessage =
+      chatReadVar remoteCtrlSession >>= \case
+        Nothing -> respondWith Status.internalServerError500 "session not active"
+        Just rcs -> atomically (readTBQueue $ remoteOutputQ rcs) >>= respondJSON
+    storeFile = case storeFileQuery of
+      Left err -> respondWith Status.badRequest400 (Binary.putStringUtf8 err)
+      Right fileName -> do
+        baseDir <- fromMaybe "." <$> chatReadVar filesFolder
+        localPath <- uniqueCombine baseDir fileName
+        logDebug $ "Storing controller file to " <> tshow (baseDir, localPath)
+        writeBodyToFile localPath reqBody
+        let storeRelative = takeFileName localPath
+        respond $ Binary.putStringUtf8 storeRelative
+      where
+        storeFileQuery = parseField "file_name" $ A.many1 (A.satisfy $ not . isPathSeparator)
+    fetchFile = case fetchFileQuery of
+      Left err -> respondWith Status.badRequest400 (Binary.putStringUtf8 err)
+      Right (userId, fileId) -> do
+        logInfo $ "Fetching file " <> tshow fileId <> " from user " <> tshow userId
+        x <- withStore' $ \db -> runExceptT $ do
+          user <- getUser db userId
+          getRcvFileTransfer db user fileId
+        case x of
+          Right RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}} -> do
+            baseDir <- fromMaybe "." <$> chatReadVar filesFolder
+            let fullPath = baseDir </> filePath
+            size <- fromInteger <$> getFileSize fullPath
+            liftIO . sendResponse . HTTP2Server.responseFile Status.ok200 mempty $ HTTP2Server.FileSpec fullPath 0 size
+          Right _ -> respondWith Status.internalServerError500 "The requested file is not complete"
+          Left SEUserNotFound {} -> respondWith Status.notFound404 "User not found"
+          Left SERcvFileNotFound {} -> respondWith Status.notFound404 "File not found"
+          _ -> respondWith Status.internalServerError500 "Store error"
+      where
+        fetchFileQuery =
+          (,)
+            <$> parseField "user_id" A.decimal
+            <*> parseField "file_id" A.decimal
 
-    respondJSON :: J.ToJSON a => a -> m ()
+    parseField :: ByteString -> A.Parser a -> Either String a
+    parseField field p = maybe (Left $ "missing " <> B.unpack field) (A.parseOnly $ p <* A.endOfInput) (join $ lookup field query)
+
+    respondJSON :: (J.ToJSON a) => a -> m ()
     respondJSON = respond . Binary.fromLazyByteString . J.encode
 
     respond = respondWith Status.ok200
@@ -282,19 +385,20 @@ discoverRemoteCtrls discovered = Discovery.withListener go
             let addr = THIPv4 (hostAddressToTuple sockAddr)
             ifM
               (atomically $ TM.member fingerprint discovered)
-              (logDebug $ "Fingerprint announce already knwon: " <> T.pack (show (addr, invite)))
-              (do
-                logInfo $ "New fingerprint announce: " <> T.pack (show (addr, invite))
-                atomically $ TM.insert fingerprint addr discovered
+              (logDebug $ "Fingerprint announce already knwon: " <> tshow (addr, invite))
+              ( do
+                  logInfo $ "New fingerprint announce: " <> tshow (addr, invite)
+                  atomically $ TM.insert fingerprint addr discovered
               )
             withStore' (`getRemoteCtrlByFingerprint` fingerprint) >>= \case
               Nothing -> toView $ CRRemoteCtrlAnnounce fingerprint -- unknown controller, ui "register" action required
-              Just found@RemoteCtrl {remoteCtrlId, accepted=storedChoice} -> case storedChoice of
+              Just found@RemoteCtrl {remoteCtrlId, accepted = storedChoice} -> case storedChoice of
                 Nothing -> toView $ CRRemoteCtrlFound found -- first-time controller, ui "accept" action required
                 Just False -> pure () -- skipping a rejected item
-                Just True -> chatReadVar remoteCtrlSession >>= \case
-                  Nothing -> toView . CRChatError Nothing . ChatError $ CEInternalError "Remote host found without running a session"
-                  Just RemoteCtrlSession {accepted} -> atomically $ void $ tryPutTMVar accepted remoteCtrlId -- previously accepted controller, connect automatically
+                Just True ->
+                  chatReadVar remoteCtrlSession >>= \case
+                    Nothing -> toView . CRChatError Nothing . ChatError $ CEInternalError "Remote host found without running a session"
+                    Just RemoteCtrlSession {accepted} -> atomically $ void $ tryPutTMVar accepted remoteCtrlId -- previously accepted controller, connect automatically
         _nonV4 -> go sock
 
 registerRemoteCtrl :: (ChatMonad m) => RemoteCtrlOOB -> m ChatResponse
@@ -343,10 +447,10 @@ stopRemoteCtrl =
         toView $ CRRemoteCtrlStopped Nothing
       pure $ CRCmdOk Nothing
 
-cancelRemoteCtrlSession_ :: MonadUnliftIO m => RemoteCtrlSession -> m ()
+cancelRemoteCtrlSession_ :: (MonadUnliftIO m) => RemoteCtrlSession -> m ()
 cancelRemoteCtrlSession_ rcs = cancelRemoteCtrlSession rcs $ pure ()
 
-cancelRemoteCtrlSession :: MonadUnliftIO m => RemoteCtrlSession -> m () -> m ()
+cancelRemoteCtrlSession :: (MonadUnliftIO m) => RemoteCtrlSession -> m () -> m ()
 cancelRemoteCtrlSession RemoteCtrlSession {discoverer, supervisor, hostServer} cleanup = do
   cancel discoverer -- may be gone by now
   case hostServer of
@@ -368,3 +472,7 @@ withRemoteCtrl remoteCtrlId action =
   withStore' (`getRemoteCtrl` remoteCtrlId) >>= \case
     Nothing -> throwError $ ChatErrorRemoteCtrl RCEMissing {remoteCtrlId}
     Just rc -> action rc
+
+utf8String :: [Char] -> ByteString
+utf8String = encodeUtf8 . T.pack
+{-# INLINE utf8String #-}
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index f9137cdba..34e2b04a6 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -9,13 +10,16 @@ module RemoteTests where
 import ChatClient
 import ChatTests.Utils
 import Control.Monad
+import qualified Data.ByteString as B
 import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.Map.Strict as M
 import Debug.Trace
 import Network.HTTP.Types (ok200)
 import qualified Network.HTTP2.Client as C
 import qualified Network.HTTP2.Server as S
 import qualified Network.Socket as N
 import qualified Network.TLS as TLS
+import qualified Simplex.Chat.Controller as Controller
 import qualified Simplex.Chat.Remote.Discovery as Discovery
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
@@ -24,8 +28,11 @@ import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Response (..), closeHTTP2Client, sendRequest)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
+import System.FilePath (makeRelative, (</>))
 import Test.Hspec
 import UnliftIO
+import UnliftIO.Concurrent (threadDelay)
+import UnliftIO.Directory
 
 remoteTests :: SpecWith FilePath
 remoteTests = describe "Handshake" $ do
@@ -141,6 +148,16 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
 
 remoteCommandTest :: (HasCallStack) => FilePath -> IO ()
 remoteCommandTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
+  let mobileFiles = "./tests/tmp/mobile_files"
+  mobile ##> ("/_files_folder " <> mobileFiles)
+  mobile <## "ok"
+  let desktopFiles = "./tests/tmp/desktop_files"
+  desktop ##> ("/_files_folder " <> desktopFiles)
+  desktop <## "ok"
+  let bobFiles = "./tests/tmp/bob_files"
+  bob ##> ("/_files_folder " <> bobFiles)
+  bob <## "ok"
+
   desktop ##> "/create remote host"
   desktop <## "remote host 1 created"
   desktop <## "connection code:"
@@ -178,12 +195,87 @@ remoteCommandTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
   bob #> "@alice hi"
   desktop <# "bob> hi"
 
+  withXFTPServer $ do
+    rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
+    desktopStore <- case M.lookup 1 rhs of
+      Just Controller.RemoteHostSessionStarted {storePath} -> pure storePath
+      _ -> fail "Host session 1 should be started"
+
+    doesFileExist "./tests/tmp/mobile_files/test.pdf" `shouldReturn` False
+    doesFileExist (desktopFiles </> desktopStore </> "test.pdf") `shouldReturn` False
+    mobileName <- userName mobile
+
+    bobsFile <- makeRelative bobFiles <$> makeAbsolute "tests/fixtures/test.pdf"
+    bob #> ("/f @" <> mobileName <> " " <> bobsFile)
+    bob <## "use /fc 1 to cancel sending"
+
+    desktop <# "bob> sends file test.pdf (266.0 KiB / 272376 bytes)"
+    desktop <## "use /fr 1 [<dir>/ | <path>] to receive it"
+    desktop ##> "/fr 1"
+    concurrently_
+      do
+        bob <## "started sending file 1 (test.pdf) to alice"
+        bob <## "completed sending file 1 (test.pdf) to alice"
+
+      do
+        desktop <## "saving file 1 from bob to test.pdf"
+        desktop <## "started receiving file 1 (test.pdf) from bob"
+
+    let desktopReceived = desktopFiles </> desktopStore </> "test.pdf"
+    desktop <## ("completed receiving file 1 (" <> desktopReceived <> ") from bob")
+    bobsFileSize <- getFileSize bobsFile
+    getFileSize desktopReceived `shouldReturn` bobsFileSize
+    bobsFileBytes <- B.readFile bobsFile
+    B.readFile desktopReceived `shouldReturn` bobsFileBytes
+
+    -- test file transit on mobile
+    mobile ##> "/fs 1"
+    mobile <## "receiving file 1 (test.pdf) complete, path: test.pdf"
+    getFileSize (mobileFiles </> "test.pdf") `shouldReturn` bobsFileSize
+    B.readFile (mobileFiles </> "test.pdf") `shouldReturn` bobsFileBytes
+
+    traceM "    - file received"
+
+    desktopFile <- makeRelative desktopFiles <$> makeAbsolute "tests/fixtures/logo.jpg" -- XXX: not necessary for _send, but required for /f
+    traceM $ "    - sending " <> show desktopFile
+    doesFileExist (bobFiles </> "logo.jpg") `shouldReturn` False
+    doesFileExist (mobileFiles </> "logo.jpg") `shouldReturn` False
+    desktop ##> "/_send @2 json {\"filePath\": \"./tests/fixtures/logo.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"hi, sending a file\"}}"
+    desktop <# "@bob hi, sending a file"
+    desktop <# "/f @bob logo.jpg"
+    desktop <## "use /fc 2 to cancel sending"
+
+    bob <# "alice> hi, sending a file"
+    bob <# "alice> sends file logo.jpg (31.3 KiB / 32080 bytes)"
+    bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
+    bob ##> "/fr 2"
+    concurrently_
+      do
+        bob <## "saving file 2 from alice to logo.jpg"
+        bob <## "started receiving file 2 (logo.jpg) from alice"
+        bob <## "completed receiving file 2 (logo.jpg) from alice"
+        bob ##> "/fs 2"
+        bob <## "receiving file 2 (logo.jpg) complete, path: logo.jpg"
+      do
+        desktop <## "started sending file 2 (logo.jpg) to bob"
+        desktop <## "completed sending file 2 (logo.jpg) to bob"
+    desktopFileSize <- getFileSize desktopFile
+    getFileSize (bobFiles </> "logo.jpg") `shouldReturn` desktopFileSize
+    getFileSize (mobileFiles </> "logo.jpg") `shouldReturn` desktopFileSize
+
+    desktopFileBytes <- B.readFile desktopFile
+    B.readFile (bobFiles </> "logo.jpg") `shouldReturn` desktopFileBytes
+    B.readFile (mobileFiles </> "logo.jpg") `shouldReturn` desktopFileBytes
+
+    traceM "    - file sent"
+
   traceM "    - post-remote checks"
   mobile ##> "/stop remote ctrl"
   mobile <## "ok"
   concurrently_
     (mobile <## "remote controller stopped")
     (desktop <## "remote host 1 stopped")
+
   mobile ##> "/contacts"
   mobile <## "bob (Bob)"
 

From c2a858b06eef39a8d235e072929535f4e8462055 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Wed, 11 Oct 2023 19:11:01 +0100
Subject: [PATCH 11/69] core: convert single-field to tagged JSON encoding
 (#3183)

* core: convert single-field to tagged JSON encoding

* rename

* rename

* fixes, test

* refactor
---
 cabal.project              |  2 +-
 package.yaml               |  2 ++
 scripts/nix/sha256map.nix  |  2 +-
 simplex-chat.cabal         |  5 ++-
 src/Simplex/Chat/Remote.hs | 39 +++++++++++++++++++++--
 stack.yaml                 |  2 +-
 tests/JSONTests.hs         | 65 ++++++++++++++++++++++++++++++++++++++
 tests/RemoteTests.hs       |  1 -
 tests/Test.hs              |  2 ++
 9 files changed, 112 insertions(+), 8 deletions(-)
 create mode 100644 tests/JSONTests.hs

diff --git a/cabal.project b/cabal.project
index 3da442ac4..1364d77bf 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: 919550948501d315aa8845cbed1781d4298d4ced
+    tag: 6b0da8ac50b1582c9f5187c316b93fc8f12c9365
 
 source-repository-package
     type: git
diff --git a/package.yaml b/package.yaml
index f7fc61478..861d0c494 100644
--- a/package.yaml
+++ b/package.yaml
@@ -120,9 +120,11 @@ tests:
       - apps/simplex-directory-service/src
     main: Test.hs
     dependencies:
+      - QuickCheck == 2.14.*
       - simplex-chat
       - async == 2.2.*
       - deepseq == 1.4.*
+      - generic-random == 1.5.*
       - hspec == 2.11.*
       - network == 3.1.*
       - silently == 1.2.*
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 0a199779d..e1880738d 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."919550948501d315aa8845cbed1781d4298d4ced" = "05d0cadhlazqi2lxcb7nvyjrf8q49c6ax7b8rahawbh1zmwg38nm";
+  "https://github.com/simplex-chat/simplexmq.git"."6b0da8ac50b1582c9f5187c316b93fc8f12c9365" = "18n0b1l1adraw5rq118a6iz9pqg43yf41vrzm193q1si06iwk24b";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "0kiwhvml42g9anw4d2v0zd1fpc790pj9syg5x3ik4l97fnkbbwpp";
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 81a71a910..4fc023bc3 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -488,6 +488,7 @@ test-suite simplex-chat-test
       ChatTests.Groups
       ChatTests.Profiles
       ChatTests.Utils
+      JSONTests
       MarkdownTests
       MobileTests
       ProtocolTests
@@ -509,7 +510,8 @@ test-suite simplex-chat-test
       apps/simplex-directory-service/src
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
-      aeson ==2.2.*
+      QuickCheck ==2.14.*
+    , aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
     , async ==2.2.*
     , attoparsec ==0.14.*
@@ -528,6 +530,7 @@ test-suite simplex-chat-test
     , email-validate ==2.3.*
     , exceptions ==0.10.*
     , filepath ==1.4.*
+    , generic-random ==1.5.*
     , hspec ==2.11.*
     , http-types ==0.12.*
     , http2 ==4.1.*
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 0f03c1fdb..b81ba33cd 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -16,7 +17,10 @@ import Control.Monad.IO.Class
 import Control.Monad.Reader (asks)
 import Control.Monad.STM (retry)
 import Crypto.Random (getRandomBytes)
+import Data.Aeson ((.=))
 import qualified Data.Aeson as J
+import qualified Data.Aeson.Key as JK
+import qualified Data.Aeson.KeyMap as JM
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.Binary.Builder as Binary
 import Data.ByteString (ByteString, hPut)
@@ -47,6 +51,7 @@ import Simplex.FileTransfer.Util (uniqueCombine)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Parsers (pattern SingleFieldJSONTag, pattern TaggedObjectJSONTag, pattern TaggedObjectJSONData)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
@@ -233,9 +238,37 @@ handleRcvFileComplete http storePath remoteUser cif@CIFile {fileId, fileName, fi
 
 -- | Convert swift single-field sum encoding into tagged/discriminator-field
 owsf2tagged :: J.Value -> J.Value
-owsf2tagged = \case
-  J.Object todo'convert -> J.Object todo'convert
-  skip -> skip
+owsf2tagged = fst . convert
+  where
+    convert val = case val of
+      J.Object o
+        | JM.size o == 2 ->
+            case JM.toList o of
+              [OwsfTag, o'] -> tagged o'
+              [o', OwsfTag] -> tagged o'
+              _ -> props
+        | otherwise -> props
+        where
+          props = (J.Object $ fmap owsf2tagged o, False)
+      J.Array a -> (J.Array $ fmap owsf2tagged a, False)
+      _ -> (val, False)
+    -- `tagged` converts the pair of single-field object encoding to tagged encoding.
+    -- It sets innerTag returned by `convert` to True to prevent the tag being overwritten.
+    tagged (k, v) = (J.Object pairs, True)
+      where
+        (v', innerTag) = convert v
+        pairs = case v' of
+          -- `innerTag` indicates that internal object already has tag,
+          -- so the current tag cannot be inserted into it.
+          J.Object o
+            | innerTag -> pair
+            | otherwise -> JM.insert TaggedObjectJSONTag tag o
+          _ -> pair
+        tag = J.String $ JK.toText k
+        pair = JM.fromList [TaggedObjectJSONTag .= tag, TaggedObjectJSONData .= v']
+
+pattern OwsfTag :: (JK.Key, J.Value)
+pattern OwsfTag = (SingleFieldJSONTag, J.Bool True)
 
 storeRemoteFile :: (MonadUnliftIO m) => HTTP2Client -> FilePath -> m (Maybe FilePath)
 storeRemoteFile http localFile = do
diff --git a/stack.yaml b/stack.yaml
index 5d9fc214f..e467b040e 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: 919550948501d315aa8845cbed1781d4298d4ced
+    commit: 6b0da8ac50b1582c9f5187c316b93fc8f12c9365
   - github: kazu-yamamoto/http2
     commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
   # - ../direct-sqlcipher
diff --git a/tests/JSONTests.hs b/tests/JSONTests.hs
new file mode 100644
index 000000000..11567d94a
--- /dev/null
+++ b/tests/JSONTests.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module JSONTests where
+
+import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Aeson as J
+import qualified Data.Aeson.Types as JT
+import qualified Data.ByteString.Lazy.Char8 as LB
+import GHC.Generics (Generic)
+import Generic.Random (genericArbitraryU)
+import MobileTests
+import Simplex.Chat.Remote (owsf2tagged)
+import Simplex.Messaging.Parsers
+import Test.Hspec
+import Test.Hspec.QuickCheck (modifyMaxSuccess)
+import Test.QuickCheck (Arbitrary (..), property)
+
+jsonTests :: Spec
+jsonTests = describe "owsf2tagged" $ do
+  it "should convert chat types" owsf2TaggedJSONTest
+  describe "SomeType" owsf2TaggedSomeTypeTests
+
+owsf2TaggedJSONTest :: IO ()
+owsf2TaggedJSONTest = do
+  noActiveUserSwift `to` noActiveUserTagged
+  activeUserExistsSwift `to` activeUserExistsTagged
+  activeUserSwift `to` activeUserTagged
+  chatStartedSwift `to` chatStartedTagged
+  contactSubSummarySwift `to` contactSubSummaryTagged
+  memberSubSummarySwift `to` memberSubSummaryTagged
+  userContactSubSummarySwift `to` userContactSubSummaryTagged
+  pendingSubSummarySwift `to` pendingSubSummaryTagged
+  parsedMarkdownSwift `to` parsedMarkdownTagged
+  where
+    to :: LB.ByteString -> LB.ByteString -> IO ()
+    owsf `to` tagged =
+      case J.eitherDecode owsf of
+        Right json -> Right (owsf2tagged json) `shouldBe` J.eitherDecode tagged
+        Left e -> expectationFailure e
+
+data SomeType
+  = Nullary
+  | Unary (Maybe SomeType)
+  | Product String (Maybe SomeType)
+  | Record
+      { testOne :: Int,
+        testTwo :: Maybe Bool,
+        testThree :: Maybe SomeType
+      }
+  | List [Int]
+  deriving (Eq, Show, Generic)
+
+instance Arbitrary SomeType where arbitrary = genericArbitraryU
+
+instance ToJSON SomeType where
+  toJSON = J.genericToJSON $ singleFieldJSON_ (Just SingleFieldJSONTag) id
+  toEncoding = J.genericToEncoding $ singleFieldJSON_ (Just SingleFieldJSONTag) id
+
+instance FromJSON SomeType where
+  parseJSON = J.genericParseJSON $ taggedObjectJSON id
+
+owsf2TaggedSomeTypeTests :: Spec
+owsf2TaggedSomeTypeTests =
+  modifyMaxSuccess (const 10000) $ it "should convert to tagged" $ property $ \x ->
+    (JT.parseMaybe J.parseJSON . owsf2tagged . J.toJSON) x == Just (x :: SomeType)
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 34e2b04a6..84f361a4a 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module RemoteTests where
diff --git a/tests/Test.hs b/tests/Test.hs
index 1e2cad037..071ff3791 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -5,6 +5,7 @@ import ChatTests
 import ChatTests.Utils (xdescribe'')
 import Control.Logger.Simple
 import Data.Time.Clock.System
+import JSONTests
 import MarkdownTests
 import MobileTests
 import ProtocolTests
@@ -22,6 +23,7 @@ main = do
   withGlobalLogging logCfg . hspec $ do
     describe "Schema dump" schemaDumpTest
     describe "SimpleX chat markdown" markdownTests
+    describe "JSON Tests" jsonTests
     describe "SimpleX chat view" viewTests
     describe "SimpleX chat protocol" protocolTests
     describe "WebRTC encryption" webRTCTests

From adc1f8c983878bbabb0bc912404884464f2ddeab Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Thu, 12 Oct 2023 12:58:59 +0300
Subject: [PATCH 12/69] android, desktop: remote kotlin types (#3200)

* Add remote types to Kotlin

* update response info for chat console

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 .../chat/simplex/common/model/SimpleXAPI.kt   | 163 ++++++++++++++++++
 1 file changed, 163 insertions(+)

diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
index 3644268ba..50c52b631 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
@@ -1915,6 +1915,18 @@ sealed class CC {
   class ApiChatUnread(val type: ChatType, val id: Long, val unreadChat: Boolean): CC()
   class ReceiveFile(val fileId: Long, val encrypted: Boolean, val inline: Boolean?): CC()
   class CancelFile(val fileId: Long): CC()
+  class CreateRemoteHost(): CC()
+  class ListRemoteHosts(): CC()
+  class StartRemoteHost(val remoteHostId: Long): CC()
+  class StopRemoteHost(val remoteHostId: Long): CC()
+  class DeleteRemoteHost(val remoteHostId: Long): CC()
+  class RegisterRemoteCtrl(val remoteCtrlOOB: RemoteCtrlOOB): CC()
+  class StartRemoteCtrl(): CC()
+  class ListRemoteCtrls(): CC()
+  class AcceptRemoteCtrl(val remoteCtrlId: Long): CC()
+  class RejectRemoteCtrl(val remoteCtrlId: Long): CC()
+  class StopRemoteCtrl(): CC()
+  class DeleteRemoteCtrl(val remoteCtrlId: Long): CC()
   class ShowVersion(): CC()
 
   val cmdString: String get() = when (this) {
@@ -2022,6 +2034,18 @@ sealed class CC {
     is ApiChatUnread -> "/_unread chat ${chatRef(type, id)} ${onOff(unreadChat)}"
     is ReceiveFile -> "/freceive $fileId encrypt=${onOff(encrypted)}" + (if (inline == null) "" else " inline=${onOff(inline)}")
     is CancelFile -> "/fcancel $fileId"
+    is CreateRemoteHost -> "/create remote host"
+    is ListRemoteHosts -> "/list remote hosts"
+    is StartRemoteHost -> "/start remote host $remoteHostId"
+    is StopRemoteHost -> "/stop remote host $remoteHostId"
+    is DeleteRemoteHost -> "/delete remote host $remoteHostId"
+    is StartRemoteCtrl -> "/start remote ctrl"
+    is RegisterRemoteCtrl -> "/register remote ctrl ${remoteCtrlOOB.caFingerprint}"
+    is AcceptRemoteCtrl -> "/accept remote ctrl $remoteCtrlId"
+    is RejectRemoteCtrl -> "/reject remote ctrl $remoteCtrlId"
+    is ListRemoteCtrls -> "/list remote ctrls"
+    is StopRemoteCtrl -> "/stop remote ctrl"
+    is DeleteRemoteCtrl -> "/delete remote ctrl $remoteCtrlId"
     is ShowVersion -> "/version"
   }
 
@@ -2118,6 +2142,18 @@ sealed class CC {
     is ApiChatUnread -> "apiChatUnread"
     is ReceiveFile -> "receiveFile"
     is CancelFile -> "cancelFile"
+    is CreateRemoteHost -> "createRemoteHost"
+    is ListRemoteHosts -> "listRemoteHosts"
+    is StartRemoteHost -> "startRemoteHost"
+    is StopRemoteHost -> "stopRemoteHost"
+    is DeleteRemoteHost -> "deleteRemoteHost"
+    is RegisterRemoteCtrl -> "registerRemoteCtrl"
+    is StartRemoteCtrl -> "startRemoteCtrl"
+    is ListRemoteCtrls -> "listRemoteCtrls"
+    is AcceptRemoteCtrl -> "acceptRemoteCtrl"
+    is RejectRemoteCtrl -> "rejectRemoteCtrl"
+    is StopRemoteCtrl -> "stopRemoteCtrl"
+    is DeleteRemoteCtrl -> "deleteRemoteCtrl"
     is ShowVersion -> "showVersion"
   }
 
@@ -3180,6 +3216,34 @@ enum class GroupFeatureEnabled {
 
 }
 
+@Serializable
+data class RemoteCtrl (
+  val remoteCtrlId: Long,
+  val displayName: String,
+  val fingerprint: String,
+  val accepted: Boolean?
+)
+
+@Serializable
+data class RemoteCtrlOOB (
+  val caFingerprint: String
+)
+
+@Serializable
+data class RemoteCtrlInfo (
+  val remoteCtrlId: Long,
+  val displayName: String,
+  val sessionActive: Boolean
+)
+
+@Serializable
+data class RemoteHostInfo (
+  val remoteHostId: Long,
+  val storePath: String,
+  val displayName: String,
+  val sessionActive: Boolean
+)
+
 val json = Json {
   prettyPrint = true
   ignoreUnknownKeys = true
@@ -3401,6 +3465,26 @@ sealed class CR {
   @Serializable @SerialName("chatCmdError") class ChatCmdError(val user_: UserRef?, val chatError: ChatError): CR()
   @Serializable @SerialName("chatError") class ChatRespError(val user_: UserRef?, val chatError: ChatError): CR()
   @Serializable @SerialName("archiveImported") class ArchiveImported(val archiveErrors: List<ArchiveError>): CR()
+  // remote events (desktop)
+  @Serializable @SerialName("remoteHostCreated") class RemoteHostCreated(val remoteHostId: Long, val oobData: RemoteCtrlOOB): CR()
+  @Serializable @SerialName("remoteHostList") class RemoteHostList(val remoteHosts: List<RemoteHostInfo>): CR()
+  @Serializable @SerialName("remoteHostStarted") class RemoteHostStarted(val remoteHostId: Long): CR()
+  @Serializable @SerialName("remoteHostConnected") class RemoteHostConnected(val remoteHostId: Long): CR()
+  @Serializable @SerialName("remoteHostStopped") class RemoteHostStopped(val remoteHostId: Long): CR()
+  @Serializable @SerialName("remoteHostDeleted") class RemoteHostDeleted(val remoteHostId: Long): CR()
+  // remote events (mobile)
+  @Serializable @SerialName("remoteCtrlList") class RemoteCtrlList(val remoteCtrls: List<RemoteCtrlInfo>): CR()
+  @Serializable @SerialName("remoteCtrlRegistered") class RemoteCtrlRegistered(val remoteCtrlId: Long): CR()
+  @Serializable @SerialName("remoteCtrlStarted") class RemoteCtrlStarted(): CR()
+  @Serializable @SerialName("remoteCtrlAnnounce") class RemoteCtrlAnnounce(val fingerprint: String): CR()
+  @Serializable @SerialName("remoteCtrlFound") class RemoteCtrlFound(val remoteCtrl: RemoteCtrl): CR()
+  @Serializable @SerialName("remoteCtrlAccepted") class RemoteCtrlAccepted(val remoteCtrlId: Long): CR()
+  @Serializable @SerialName("remoteCtrlRejected") class RemoteCtrlRejected(val remoteCtrlId: Long): CR()
+  @Serializable @SerialName("remoteCtrlConnecting") class RemoteCtrlConnecting(val remoteCtrlId: Long, val displayName: String): CR()
+  @Serializable @SerialName("remoteCtrlConnected") class RemoteCtrlConnected(val remoteCtrlId: Long, val displayName: String): CR()
+  @Serializable @SerialName("remoteCtrlStopped") class RemoteCtrlStopped(): CR()
+  @Serializable @SerialName("remoteCtrlDeleted") class RemoteCtrlDeleted(val remoteCtrlId: Long): CR()
+  // general
   @Serializable class Response(val type: String, val json: String): CR()
   @Serializable class Invalid(val str: String): CR()
 
@@ -3529,6 +3613,23 @@ sealed class CR {
     is ChatCmdError -> "chatCmdError"
     is ChatRespError -> "chatError"
     is ArchiveImported -> "archiveImported"
+    is RemoteHostCreated -> "remoteHostCreated"
+    is RemoteHostList -> "remoteHostList"
+    is RemoteHostStarted -> "remoteHostStarted"
+    is RemoteHostConnected -> "remoteHostConnected"
+    is RemoteHostStopped -> "remoteHostStopped"
+    is RemoteHostDeleted -> "remoteHostDeleted"
+    is RemoteCtrlList -> "remoteCtrlList"
+    is RemoteCtrlRegistered -> "remoteCtrlRegistered"
+    is RemoteCtrlStarted -> "remoteCtrlStarted"
+    is RemoteCtrlAnnounce -> "remoteCtrlAnnounce"
+    is RemoteCtrlFound -> "remoteCtrlFound"
+    is RemoteCtrlAccepted -> "remoteCtrlAccepted"
+    is RemoteCtrlRejected -> "remoteCtrlRejected"
+    is RemoteCtrlConnecting -> "remoteCtrlConnecting"
+    is RemoteCtrlConnected -> "remoteCtrlConnected"
+    is RemoteCtrlStopped -> "remoteCtrlStopped"
+    is RemoteCtrlDeleted -> "remoteCtrlDeleted"
     is Response -> "* $type"
     is Invalid -> "* invalid json"
   }
@@ -3660,6 +3761,23 @@ sealed class CR {
     is ChatCmdError -> withUser(user_, chatError.string)
     is ChatRespError -> withUser(user_, chatError.string)
     is ArchiveImported -> "${archiveErrors.map { it.string } }"
+    is RemoteHostCreated -> "remote host ID: $remoteHostId\noobData ${json.encodeToString(oobData)}"
+    is RemoteHostList -> "remote hosts: ${json.encodeToString(remoteHosts)}"
+    is RemoteHostStarted -> "remote host $remoteHostId"
+    is RemoteHostConnected -> "remote host ID: $remoteHostId"
+    is RemoteHostStopped -> "remote host ID: $remoteHostId"
+    is RemoteHostDeleted -> "remote host ID: $remoteHostId"
+    is RemoteCtrlList -> json.encodeToString(remoteCtrls)
+    is RemoteCtrlRegistered -> "remote ctrl ID: $remoteCtrlId"
+    is RemoteCtrlStarted -> ""
+    is RemoteCtrlAnnounce -> "fingerprint: $fingerprint"
+    is RemoteCtrlFound -> "remote ctrl: ${json.encodeToString(remoteCtrl)}"
+    is RemoteCtrlAccepted -> "remote ctrl ID: $remoteCtrlId"
+    is RemoteCtrlRejected -> "remote ctrl ID: $remoteCtrlId"
+    is RemoteCtrlConnecting -> "remote ctrl ID: $remoteCtrlId\nhost displayName: $displayName"
+    is RemoteCtrlConnected -> "remote ctrl ID: $remoteCtrlId\nhost displayName: $displayName"
+    is RemoteCtrlStopped -> ""
+    is RemoteCtrlDeleted -> "remote ctrl ID: $remoteCtrlId"
     is Response -> json
     is Invalid -> str
   }
@@ -3805,12 +3923,16 @@ sealed class ChatError {
     is ChatErrorAgent -> "agent ${agentError.string}"
     is ChatErrorStore -> "store ${storeError.string}"
     is ChatErrorDatabase -> "database ${databaseError.string}"
+    is ChatErrorRemoteCtrl -> "remoteCtrl ${remoteCtrlError.string}"
+    is ChatErrorRemoteHost -> "remoteHost ${remoteHostError.string}"
     is ChatErrorInvalidJSON -> "invalid json ${json}"
   }
   @Serializable @SerialName("error") class ChatErrorChat(val errorType: ChatErrorType): ChatError()
   @Serializable @SerialName("errorAgent") class ChatErrorAgent(val agentError: AgentErrorType): ChatError()
   @Serializable @SerialName("errorStore") class ChatErrorStore(val storeError: StoreError): ChatError()
   @Serializable @SerialName("errorDatabase") class ChatErrorDatabase(val databaseError: DatabaseError): ChatError()
+  @Serializable @SerialName("errorRemoteCtrl") class ChatErrorRemoteCtrl(val remoteCtrlError: RemoteCtrlError): ChatError()
+  @Serializable @SerialName("errorRemoteHost") class ChatErrorRemoteHost(val remoteHostError: RemoteHostError): ChatError()
   @Serializable @SerialName("invalidJSON") class ChatErrorInvalidJSON(val json: String): ChatError()
 }
 
@@ -4310,6 +4432,47 @@ sealed class ArchiveError {
   @Serializable @SerialName("importFile") class ArchiveErrorImportFile(val file: String, val chatError: ChatError): ArchiveError()
 }
 
+@Serializable
+sealed class RemoteHostError {
+  val string: String get() = when (this) {
+    is Missing -> "missing"
+    is Busy -> "busy"
+    is Rejected -> "rejected"
+    is Timeout -> "timeout"
+    is Disconnected -> "disconnected"
+    is ConnectionLost -> "connectionLost"
+  }
+  @Serializable @SerialName("missing") object Missing: RemoteHostError()
+  @Serializable @SerialName("busy") object Busy: RemoteHostError()
+  @Serializable @SerialName("rejected") object Rejected: RemoteHostError()
+  @Serializable @SerialName("timeout") object Timeout: RemoteHostError()
+  @Serializable @SerialName("disconnected") class Disconnected(val reason: String): RemoteHostError()
+  @Serializable @SerialName("connectionLost") class ConnectionLost(val reason: String): RemoteHostError()
+}
+
+@Serializable
+sealed class RemoteCtrlError {
+  val string: String get() = when (this) {
+    is Missing -> "missing"
+    is Inactive -> "inactive"
+    is Busy -> "busy"
+    is Timeout -> "timeout"
+    is Disconnected -> "disconnected"
+    is ConnectionLost -> "connectionLost"
+    is CertificateExpired -> "certificateExpired"
+    is CertificateUntrusted -> "certificateUntrusted"
+    is BadFingerprint -> "badFingerprint"
+  }
+  @Serializable @SerialName("missing") class Missing(val remoteCtrlId: Long): RemoteCtrlError()
+  @Serializable @SerialName("inactive") object Inactive: RemoteCtrlError()
+  @Serializable @SerialName("busy") object Busy: RemoteCtrlError()
+  @Serializable @SerialName("timeout") object Timeout: RemoteCtrlError()
+  @Serializable @SerialName("disconnected") class Disconnected(val remoteCtrlId: Long, val reason: String): RemoteCtrlError()
+  @Serializable @SerialName("connectionLost") class ConnectionLost(val remoteCtrlId: Long, val reason: String): RemoteCtrlError()
+  @Serializable @SerialName("certificateExpired") class CertificateExpired(val remoteCtrlId: Long): RemoteCtrlError()
+  @Serializable @SerialName("certificateUntrusted") class CertificateUntrusted(val remoteCtrlId: Long): RemoteCtrlError()
+  @Serializable @SerialName("badFingerprint") object BadFingerprint: RemoteCtrlError()
+}
 
 enum class NotificationsMode() {
   OFF, PERIODIC, SERVICE, /*INSTANT - for Firebase notifications */;

From fe6c65f75cdb8c9b5dd4e8c29983fc28431fd62b Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Thu, 12 Oct 2023 17:19:19 +0300
Subject: [PATCH 13/69] rfc: remote profile (#3051)

* Add session UX for mobile and desktop

* Resolve some feedback

* Resolve more feedback

Add QR note for desktops.
Add TLS handshake notice.

* Add details
---
 docs/rfcs/2023-09-12-remote-profile.md | 200 +++++++++++++++++++++++++
 1 file changed, 200 insertions(+)
 create mode 100644 docs/rfcs/2023-09-12-remote-profile.md

diff --git a/docs/rfcs/2023-09-12-remote-profile.md b/docs/rfcs/2023-09-12-remote-profile.md
new file mode 100644
index 000000000..9a41d55d5
--- /dev/null
+++ b/docs/rfcs/2023-09-12-remote-profile.md
@@ -0,0 +1,200 @@
+# Remote profile
+
+## Problem
+
+Users want their desktop client to be in sync with profiles at their main device (presumably a mobile phone).
+Due to distributed nature of SimpleX chat and comprehensive encryption it is difficult to maintain up to date multi-way synchronized presentation between devices.
+
+## Solution
+
+A typical (and expected) solution for this is running a server on a master device which will handle all the communication.
+Then, additional "thin" client(s) would be able to present an interface, delegating everything else to the main.
+
+Fortunately, we already have such a protocol in our clients.
+CLI and GUI run a text+json RPC protocol to their chat core.
+CLI has a WebSocket server for it that facilitates making custom clients and bots – it won't be usable here though.
+
+We can run this protocol over a secure channel designed specifically for this problem.
+
+Then we can tweak clients to use this protocol instead of regular "local" profiles.
+
+## Session lifecycle
+
+For the sake of grounding and familiarity the roles are:
+* "Mobile": a master device which stores data and does the communication.
+* "Desktop": UI client attached to the master.
+
+1. Discovery: a user wants to attach a desktop client to their mobile.
+2. Handshake: desktop and mobile establish a secure duplex session.
+3. Activity: desktop sends requests and receives events from mobile and updates its presentation.
+4. Restart: desktop should be able to re-eastablish channel unattended in the case of network winking out for a while.
+5. Disposal: mobile can terminate the link and permanently dispose the established session.
+
+[![](https://mermaid.ink/img/pako:eNq1Vs2O2jAQfpVRTq3EvgCqVtomrZZDKhWKtAcuxh7AxbFT27BCq5X2QdqX2yfpODHGQOitJ4jn88w3P98kLwU3Aotx4fDXDjXHSrK1Zc1CAzDujYVqDsxBhW7rTRuOW2a95LJl2kM1yYwwn1zZy9xeGouXiLpD1GYpFQ4DJhmgj9ATq-cnw0KHc208gtljID0i-xgq6Xg4OARzNb-7v68mY5iGXJ0HxzwqJelSa82qc0OoSUCVY5gI1F76A9gefhGBEJ-tYYIz8iQjNrKTe_JMkM5fGaMmf4J5dorUs2wVOyQv8H0KoS0BVAfSNV2fcabPDOF2XYZs1tJ5onRKZ5BOXQ7X6JFp4TZsi4ltnWe_PCbZBS0vi8M3TCnU6xu3LbrWaNdZTevhq7RULi8bhE0eN7qus-5wo1fSNsxLoyOkS5kov7_9LnsrkAcr9RqIBfgNgvO71Qqepd-AwL3kCE9PT4vi_e1P74Mp3__JSkvuHjjH1idUVt6a2e2pM5EUioQ7VmSGWgxwRuVwKOAUfyIfDFihQuqRjW1FcdbOgZiMZKtUHlN39OKPwIuJvB6BhwAI6X0wWh26OjZMalDGtB_PrwT68wksleFbFJ-W9t4bkg_uiWJ4cj4ECnVQknt3PoGdeoPTnifJ_JhSUl25YT5XXGc8jtUsTfgFIuNHsJ1-tqwNo-mBtXLUjZrCEdAPBNN1ITPHp4FNsYN8I7HcyrT4hyfiJFeSZ3259HaNuNm5vnTXnZtSEWhZ3to7_0nJSUTJS6-f_jAflhH0C9ftSPEsjlmXYtJF8tFL4paPsCSNI4Gjc7FeXZluLn5CMxXZntpyJ7X0kp7E2SuBFFmhZ3xz2qJRm2kyf6BtpA4FziikOlV4FOyZXEOa8GicP4-bb4IbcbN9MOg5le02r-6to_dMSZGZoZNoNmZZ9SajvhENPSZ8_746bvBv5mhwNBNhTdD6vWpaUEJ45atAXGPUeT7QZWJQjIqGcmBS0HfISzheFLSCGlwUY_oraAEvioV-JRzbeTM7aF6MV4wqOyp2bUgtfrRcnH4Rkr4T4uHrX2MK93E?type=png)](https://mermaid-js.github.io/mermaid-live-editor/edit#pako:eNq1Vs2O2jAQfpVRTq3EvgCqVtomrZZDKhWKtAcuxh7AxbFT27BCq5X2QdqX2yfpODHGQOitJ4jn88w3P98kLwU3Aotx4fDXDjXHSrK1Zc1CAzDujYVqDsxBhW7rTRuOW2a95LJl2kM1yYwwn1zZy9xeGouXiLpD1GYpFQ4DJhmgj9ATq-cnw0KHc208gtljID0i-xgq6Xg4OARzNb-7v68mY5iGXJ0HxzwqJelSa82qc0OoSUCVY5gI1F76A9gefhGBEJ-tYYIz8iQjNrKTe_JMkM5fGaMmf4J5dorUs2wVOyQv8H0KoS0BVAfSNV2fcabPDOF2XYZs1tJ5onRKZ5BOXQ7X6JFp4TZsi4ltnWe_PCbZBS0vi8M3TCnU6xu3LbrWaNdZTevhq7RULi8bhE0eN7qus-5wo1fSNsxLoyOkS5kov7_9LnsrkAcr9RqIBfgNgvO71Qqepd-AwL3kCE9PT4vi_e1P74Mp3__JSkvuHjjH1idUVt6a2e2pM5EUioQ7VmSGWgxwRuVwKOAUfyIfDFihQuqRjW1FcdbOgZiMZKtUHlN39OKPwIuJvB6BhwAI6X0wWh26OjZMalDGtB_PrwT68wksleFbFJ-W9t4bkg_uiWJ4cj4ECnVQknt3PoGdeoPTnifJ_JhSUl25YT5XXGc8jtUsTfgFIuNHsJ1-tqwNo-mBtXLUjZrCEdAPBNN1ITPHp4FNsYN8I7HcyrT4hyfiJFeSZ3259HaNuNm5vnTXnZtSEWhZ3to7_0nJSUTJS6-f_jAflhH0C9ftSPEsjlmXYtJF8tFL4paPsCSNI4Gjc7FeXZluLn5CMxXZntpyJ7X0kp7E2SuBFFmhZ3xz2qJRm2kyf6BtpA4FziikOlV4FOyZXEOa8GicP4-bb4IbcbN9MOg5le02r-6to_dMSZGZoZNoNmZZ9SajvhENPSZ8_746bvBv5mhwNBNhTdD6vWpaUEJ45atAXGPUeT7QZWJQjIqGcmBS0HfISzheFLSCGlwUY_oraAEvioV-JRzbeTM7aF6MV4wqOyp2bUgtfrRcnH4Rkr4T4uHrX2MK93E)
+
+### Discovery
+
+The expected flow is desktop initiates the discovery by generating OOB key data and shows a QR code for mobile to scan.
+The mobile then scans that QR code, decodes the "attachment request" and spins up a network server.
+
+There is a problem here, that the desktop doesn't know where its mobile actually located.
+
+This can be solved in a few different ways:
+
+1. The desktop starts a server and encodes its local IP in the QR. Mobile then connects to it.
+2. The desktop encodes its local IP, but mobile only does a minimal client legwork, only to signal its actual location. Then the sides flip.
+  * The legwork may entail sending UDP datagram to desktop IP with an IP of its own.
+  * Another option is to use a TCP "nanoprotocol" of sending a `host:port` line.
+3. The mobile may start announcing itself with UDP broadcasts for the duration of the phase (bluetooth-style) using information in the QR code.
+4. A desktop may create a temporary SMP queue and show its address. The mobile then submits its server data to it.
+
+Another option is to run the server on desktop and have mobile discover it with the help of QR code to get server identity and keys and then on the network via some protocol. Using a fixed address is suboptimal as most networks have dynamic IPs.
+
+### Handshake
+
+The aim of this phase is to establish a TLS+cryptobox session.
+
+TLS could be complex as we need to generate self-signed certificates on desktop (if it acts like a server). A plaintext ws connection with cryptobox encryption could be sufficient initially?
+
+TBD
+
+### Activity
+
+The desktop starts its chat core with a special parameter to signal that it should be using the session instead of its regular "local" database. This can be determined per user profile.
+
+Other than that, the client behaves like it would do with a local chat state.
+Its chat core being handed a socket uses it to relay the chat protocol data.
+
+The mobile, starts replaying the commands it had received on its state, maintaining a single point of truth.
+When a mobile receives events or replies, it mirrors them to the attached session.
+
+Only a subset of the chat API should be available this way.
+Requests like `/_stop` or `/_db delete` should be filtered out and ignored.
+
+Some of the relayed commands (e.g. `/_read chat` or `/_reaction`) the mobile should apply to its own state too.
+
+A simpler solution could be that while desktop client is connected mobile UI is locked. When the session terminates, mobile UI gets unlocked and refreshed.
+
+> A tweak in protocol that would reply with an event like "accepted read of X up to Y" may remove the need for such matching and interpretation.
+
+### Restart
+
+It would be annoying to users if walking to another room and loosing WiFi connection for a few seconds would result in another QR dance.
+
+Therefore, the non-ephemeral part of handshake material should be reused for reconnects.
+
+TBD
+
+### Disposal
+
+The session may have a lifetime that a desktop or a mobile may stipulate while preparing a session.
+Alternatively a mobile (or a desktop, why not) may signal that they're done here and no further activity should be going with the session parameters.
+
+## Proposed UX flow
+
+> For now, desktop and mobile roles are mutually exclusive.
+> Mobile device can only host remote session, while desktop devices can only remote-control.
+
+### On a mobile device
+
+1. A user opens sidebar and clicks "use from desktop" in the "You" section, starting remote controller discovery.
+  * When this happens for the first time, the user must set the mobile device name, pre-filled from system device name if possible.
+  * UI enters "Waiting for desktop" window, which collects all the broadcasts received so far.
+    -
+  * Discovery process starts UDP broadcast listener on application port (5226).
+  * A datagram containing remote controller fingerprint is checked against a list of pre-registered controller devices.
+    - If the datagram contains no valid fingerprint, it is ignored.
+    - For unknown/new broadcasts a fingerprint is displayed instead.
+    - If the device is already known, the host establishes connection and UI transitions into "connection status" window.
+2. Clicking on unknown device fingerprint in the list starts OOB handshake.
+  * UI enters "New device" window, displaying a fingerprint and asking to scan a QR code (or paste a link, like in the contact screen).
+  * A OOB data from the QR/link contains remote controller fingerprint and remote display name, which is stored in device DB.
+    - The OOB fingerprint must match the announce.
+  * Accepting the OOB automatically triggers remote controller connection and transitions UI to "connection status" window.
+3. A remote session initiated with a known device, or as a result of OOB exchange.
+  * A "connection status" window shows registered display name and current session status.
+  * Chat controller attempts to establish a remote session.
+    - The source adddress of the datagram is used to initiate TCP connection.
+    - A TCP connection is made to the address discovered.
+    - A TLS connection is instantiated, checking for remote CA fingerprint matches the previously established.
+    - A HTTP2 server is started on the mobile side of the TLS connection.
+    - The remote controller connects and subscribes for its output queue, marking the session established.
+  * For the duration of the remote session, the UI remains in the status window, preventing user interaction.
+    - This restriction may be lifted later.
+
+At any time a user may click on a "cancel" button and return to the main UI.
+That should fully re-initialise UI state.
+
+In the "Network & servers" section of "Settings", there is an item to list all the registered remote controllers with buttons attached to *dispose* them one by one.
+*Disposing* a remote controller means its entry will be removed from database.
+Future connection attempts from a disposed device would be treated exactly as from a previously-unknown device.
+
+### On a desktop device
+
+1. A user opens sidebar and clicks "connect to mobile" in the "You" section.
+  * UI enters a "Select remote host" window asking user to pick an existing connection profile or generate a new one.
+  * When a new connection profile is requested by a user, a private key is generated and a new X509 root CA certificate is produced and stored in device DB. Then the desktop proceeds to the connection screen.
+2. Clicking on an existing connection profile transitions UI to "connecting to remote host" window.
+  * For a first-time connection a QR code / link is presented, containing the fingerprint of the CA stored for the selected profile.
+    - After first time the QR code is hidden until a subdued "show QR code" button is clicked. This is to prevent user confusion that they have to scan the code every time.
+  * A new session certificate is derived from the CA.
+  * A TLS server is started using ephemeral session certificate.
+    - TLS handshake is used to authenticate desktop to a connecting mobile, proving that the announcer is indeed owns the key with the fingerprint received OOB by mobile. See below for a case for mutual authentication.
+  * A periodic UDP broadcast on port 5226 is started, sending the fingerprint.
+3. When an incoming connection is established the UI transitions to "connected to remote host" window.
+  * The announcer is terminated and TCP server stops accepting new connections.
+  * Desktop chat controller establishes a remote session over the tls session.
+  * UI transitions to the "remote host" mode, shunting local profiles into background while keeping notifications coming.
+4. A user may open sidebar and click "disconnect from mobile" to close the session and return to local mode.
+  * That should fully re-initialise UI state.
+
+In the "Network & servers" section of "Settings", there is an item to list all the registered remote hosts with buttons attached to *dispose* them one by one.
+*Disposing* a remote host means its entry will be removed from database and any associated files deleted (photos, voice messages, transferred files etc).
+
+## Caveats
+
+A public WiFi spot (or a specially configured home AP) may prohibit clients to connect with each other, denying them link-local connection.
+n such an event, an alternative transports may be considered:
+- Bluetooth link.
+- USB tethering that presents an ethernet device.
+- The usual NAT traversal techniques.
+- Running localnet-providing VPNs.
+- Routing chat traffic via SMP queues.
+
+Application chat traffic may end up too chatty for the link.
+This may result in large power drain for both sides or unpleasant latency.
+Compression protocols may be used to mitigate this.
+Since we know that chat API is text+JSON Zstd compression with pre-shared dictionary may provide huge traffic savings with minimal CPU effort.
+
+There is a threat, that a device in the broadcast range may intercept discovery datagrams and eagerly connect to their sources.
+In the case of such a "honeypot", a desktop may be tricked into receiving arbitrary contacts, messages and files from the remote host.
+Some mitigations are possible for authenticating a remote host (like using OOB token as a cookie or exchanging it for a TLS client certificate).
+This is intentionally left out of scope for now, until the "remote profiles" system is audited, to be resolved in a wider context.
+
+Requesting a list of IP addresses is problematic.
+A shady app permission is required from the OS (ACCESS_NETWORK_STATE on Android).
+And then the app needs to sort through all the found interfaces and guess which one would be accessible.
+
+## "Should-works"
+
+File transfer appears to be running within the chat protocol.
+
+UI assumes that files are available in a local storage, the access to files is not part of chat RPC. This complicates things a lot.
+
+Attaching multiple sessions appears to be realistic without extensive modifications.
+
+A headless client with a global address (e.g. VPN or TOR) may be used in a manner of IRC bouncers.
+
+This may also allow "thin" mobile clients (cf. traffic concerns) and browser apps.
+
+A backup system may be implemented by attaching a headless app to a bouncer as one of the sessions.
+
+The unauthenticated remote host can be considered a feature.
+A use case for that may be something like a "dead drop" host that wakes up in response to any discovery broadcast.
+
+## Unresolved questions
+
+- What to do with WebRTC/calls?
+- Do we want attaching only to a subset of profiles?
+- Do we want a client to mix remote and local profiles?
+- Do we want M-to-N sessions? (follows naturally from the previous two)

From 392447ea331988f40725580c44b646384d506486 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Fri, 13 Oct 2023 17:52:27 +0100
Subject: [PATCH 14/69] core: fix test

---
 src/Simplex/Chat/Remote.hs | 2 ++
 tests/JSONTests.hs         | 2 +-
 tests/RemoteTests.hs       | 1 -
 3 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 96d15ee8a..49357763d 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -8,6 +8,8 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+
 module Simplex.Chat.Remote where
 
 import Control.Logger.Simple
diff --git a/tests/JSONTests.hs b/tests/JSONTests.hs
index 11567d94a..a250cdfcf 100644
--- a/tests/JSONTests.hs
+++ b/tests/JSONTests.hs
@@ -26,7 +26,7 @@ owsf2TaggedJSONTest = do
   activeUserExistsSwift `to` activeUserExistsTagged
   activeUserSwift `to` activeUserTagged
   chatStartedSwift `to` chatStartedTagged
-  contactSubSummarySwift `to` contactSubSummaryTagged
+  networkStatusesSwift `to` networkStatusesTagged
   memberSubSummarySwift `to` memberSubSummaryTagged
   userContactSubSummarySwift `to` userContactSubSummaryTagged
   pendingSubSummarySwift `to` pendingSubSummaryTagged
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 84f361a4a..d2392adbb 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -30,7 +30,6 @@ import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
 import System.FilePath (makeRelative, (</>))
 import Test.Hspec
 import UnliftIO
-import UnliftIO.Concurrent (threadDelay)
 import UnliftIO.Directory
 
 remoteTests :: SpecWith FilePath

From 193361c09a236bc4a36ed275010f140d930d2bf5 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Fri, 13 Oct 2023 20:53:04 +0300
Subject: [PATCH 15/69] core: fix remote handshake test (#3209)

* Fix remoteHandshakeTest

Sidesteps some yet to be uncovered bug when
mobile stops its side before the desktop.

* remove ambiguous update warning

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 src/Simplex/Chat/Remote.hs | 22 ++++++++++++++++------
 tests/RemoteTests.hs       | 27 +++++++++++++++++++--------
 2 files changed, 35 insertions(+), 14 deletions(-)

diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 49357763d..26d4f4bfd 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -53,7 +54,7 @@ import Simplex.FileTransfer.Util (uniqueCombine)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
-import Simplex.Messaging.Parsers (pattern SingleFieldJSONTag, pattern TaggedObjectJSONTag, pattern TaggedObjectJSONData)
+import Simplex.Messaging.Parsers (pattern SingleFieldJSONTag, pattern TaggedObjectJSONData, pattern TaggedObjectJSONTag)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
@@ -64,7 +65,7 @@ import qualified Simplex.Messaging.Transport.HTTP2.Server as HTTP2
 import Simplex.Messaging.Util (bshow, ifM, tshow)
 import System.FilePath (isPathSeparator, takeFileName, (</>))
 import UnliftIO
-import UnliftIO.Directory (createDirectoryIfMissing, getFileSize, makeAbsolute)
+import UnliftIO.Directory (createDirectoryIfMissing, getFileSize)
 
 withRemoteHostSession :: (ChatMonad m) => RemoteHostId -> (RemoteHostSession -> m a) -> m a
 withRemoteHostSession remoteHostId action = do
@@ -90,7 +91,9 @@ startRemoteHost remoteHostId = do
     cleanup finished = do
       logInfo "Remote host http2 client fininshed"
       atomically $ writeTVar finished True
-      closeRemoteHostSession remoteHostId >>= toView
+      M.lookup remoteHostId <$> chatReadVar remoteHostSessions >>= \case
+        Nothing -> logInfo $ "Session already closed for remote host " <> tshow remoteHostId
+        Just _ -> closeRemoteHostSession remoteHostId >>= toView
     run RemoteHost {storePath, caKey, caCert} = do
       finished <- newTVarIO False
       let parent = (C.signatureKeyPair caKey, caCert)
@@ -141,6 +144,7 @@ pollRemote finished http path action = loop
 
 closeRemoteHostSession :: (ChatMonad m) => RemoteHostId -> m ChatResponse
 closeRemoteHostSession remoteHostId = withRemoteHostSession remoteHostId $ \session -> do
+  logInfo $ "Closing remote host session for " <> tshow remoteHostId
   liftIO $ cancelRemoteHostSession session
   chatWriteVar currentRemoteHost Nothing
   chatModifyVar remoteHostSessions $ M.delete remoteHostId
@@ -174,8 +178,12 @@ listRemoteHosts = do
     pure RemoteHostInfo {remoteHostId, storePath, displayName, sessionActive}
 
 deleteRemoteHost :: (ChatMonad m) => RemoteHostId -> m ChatResponse
-deleteRemoteHost remoteHostId = withRemoteHost remoteHostId $ \rh -> do
-  -- TODO: delete files
+deleteRemoteHost remoteHostId = withRemoteHost remoteHostId $ \RemoteHost {storePath} -> do
+  chatReadVar filesFolder >>= \case
+    Just baseDir -> do
+      let hostStore = baseDir </> storePath
+      logError $ "TODO: remove " <> tshow hostStore
+    Nothing -> logWarn "Local file store not available while deleting remote host"
   withStore' $ \db -> deleteRemoteHostRecord db remoteHostId
   pure CRRemoteHostDeleted {remoteHostId}
 
@@ -234,7 +242,9 @@ handleRcvFileComplete http storePath remoteUser cif@CIFile {fileId, fileName, fi
         createDirectoryIfMissing True hostStore
         localPath <- uniqueCombine hostStore fileName
         ok <- fetchRemoteFile http remoteUser fileId localPath
-        pure $ Just (cif {fileName = localPath} :: CIFile 'MDRcv)
+        if ok
+          then pure $ Just (cif {fileName = localPath} :: CIFile 'MDRcv)
+          else Nothing <$ logError "fetchRemoteFile failed"
       Nothing -> Nothing <$ logError "Local file store not available while fetching remote file"
   _ -> Nothing <$ logDebug ("Ingoring invalid file notification for file (" <> tshow fileId <> ") " <> tshow fileName)
 
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index d2392adbb..479febbca 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -36,7 +36,7 @@ remoteTests :: SpecWith FilePath
 remoteTests = describe "Handshake" $ do
   it "generates usable credentials" genCredentialsTest
   it "connects announcer with discoverer over reverse-http2" announceDiscoverHttp2Test
-  xit "connects desktop and mobile" remoteHandshakeTest
+  it "connects desktop and mobile" remoteHandshakeTest
   it "send messages via remote desktop" remoteCommandTest
 
 -- * Low-level TLS with ephemeral credentials
@@ -129,6 +129,24 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   mobile <## "remote controller 1 accepted" -- alternative scenario: accepted before controller start
   mobile <## "remote controller 1 connecting to TODO"
   mobile <## "remote controller 1 connected, TODO"
+
+  traceM "    - Session active"
+  desktop ##> "/list remote hosts"
+  desktop <## "Remote hosts:"
+  desktop <## "1. TODO (active)"
+  mobile ##> "/list remote ctrls"
+  mobile <## "Remote controllers:"
+  mobile <## "1. TODO (active)"
+
+  traceM "    - Shutting desktop"
+  desktop ##> "/stop remote host 1"
+  desktop <## "remote host 1 stopped"
+  desktop ##> "/delete remote host 1"
+  desktop <## "remote host 1 deleted"
+  desktop ##> "/list remote hosts"
+  desktop <## "No remote hosts"
+
+  traceM "    - Shutting mobile"
   mobile ##> "/stop remote ctrl"
   mobile <## "ok"
   mobile <## "remote controller stopped"
@@ -137,13 +155,6 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   mobile ##> "/list remote ctrls"
   mobile <## "No remote controllers"
 
-  desktop ##> "/stop remote host 1"
-  desktop <## "remote host 1 stopped"
-  desktop ##> "/delete remote host 1"
-  desktop <## "remote host 1 deleted"
-  desktop ##> "/list remote hosts"
-  desktop <## "No remote hosts"
-
 remoteCommandTest :: (HasCallStack) => FilePath -> IO ()
 remoteCommandTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
   let mobileFiles = "./tests/tmp/mobile_files"

From 5e6aaffb09b528f9d7af62c07a0f48cd8b3a9d73 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Fri, 13 Oct 2023 22:35:30 +0100
Subject: [PATCH 16/69] simplify remote api, add ios api (#3213)

---
 apps/ios/Shared/Model/SimpleXAPI.swift        | 32 +++++++
 apps/ios/SimpleXChat/APITypes.swift           | 72 ++++++++++++++
 .../chat/simplex/common/model/SimpleXAPI.kt   | 96 ++++++++-----------
 src/Simplex/Chat.hs                           | 24 ++---
 src/Simplex/Chat/Controller.hs                | 14 +--
 src/Simplex/Chat/Remote.hs                    | 45 ++++-----
 src/Simplex/Chat/View.hs                      |  6 --
 tests/RemoteTests.hs                          | 18 ++--
 tests/Test.hs                                 |  2 +-
 9 files changed, 184 insertions(+), 125 deletions(-)

diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift
index a1c8cee77..ad76364e9 100644
--- a/apps/ios/Shared/Model/SimpleXAPI.swift
+++ b/apps/ios/Shared/Model/SimpleXAPI.swift
@@ -882,6 +882,38 @@ func apiCancelFile(fileId: Int64) async -> AChatItem? {
     }
 }
 
+func startRemoteCtrl() async throws {
+    try await sendCommandOkResp(.startRemoteCtrl)
+}
+
+func registerRemoteCtrl(_ remoteCtrlOOB: RemoteCtrlOOB) async throws -> Int64 {
+    let r = await chatSendCmd(.registerRemoteCtrl(remoteCtrlOOB: remoteCtrlOOB))
+    if case let .remoteCtrlRegistered(rcId) = r { return rcId }
+    throw r
+}
+
+func listRemoteCtrls() async throws -> [RemoteCtrlInfo] {
+    let r = await chatSendCmd(.listRemoteCtrls)
+    if case let .remoteCtrlList(rcInfo) = r { return rcInfo }
+    throw r
+}
+
+func acceptRemoteCtrl(_ rcId: Int64) async throws {
+    try await sendCommandOkResp(.acceptRemoteCtrl(remoteCtrlId: rcId))
+}
+
+func rejectRemoteCtrl(_ rcId: Int64) async throws {
+    try await sendCommandOkResp(.rejectRemoteCtrl(remoteCtrlId: rcId))
+}
+
+func stopRemoteCtrl() async throws {
+    try await sendCommandOkResp(.stopRemoteCtrl)
+}
+
+func deleteRemoteCtrl(_ rcId: Int64) async throws {
+    try await sendCommandOkResp(.deleteRemoteCtrl(remoteCtrlId: rcId))
+}
+
 func networkErrorAlert(_ r: ChatResponse) -> Alert? {
     switch r {
     case let .chatCmdError(_, .errorAgent(.BROKER(addr, .TIMEOUT))):
diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift
index 9eb9b9084..4b79800e1 100644
--- a/apps/ios/SimpleXChat/APITypes.swift
+++ b/apps/ios/SimpleXChat/APITypes.swift
@@ -117,6 +117,13 @@ public enum ChatCommand {
     case receiveFile(fileId: Int64, encrypted: Bool, inline: Bool?)
     case setFileToReceive(fileId: Int64, encrypted: Bool)
     case cancelFile(fileId: Int64)
+    case startRemoteCtrl
+    case registerRemoteCtrl(remoteCtrlOOB: RemoteCtrlOOB)
+    case listRemoteCtrls
+    case acceptRemoteCtrl(remoteCtrlId: Int64)
+    case rejectRemoteCtrl(remoteCtrlId: Int64)
+    case stopRemoteCtrl
+    case deleteRemoteCtrl(remoteCtrlId: Int64)
     case showVersion
     case string(String)
 
@@ -255,6 +262,13 @@ public enum ChatCommand {
                 return s
             case let .setFileToReceive(fileId, encrypted): return "/_set_file_to_receive \(fileId) encrypt=\(onOff(encrypted))"
             case let .cancelFile(fileId): return "/fcancel \(fileId)"
+            case .startRemoteCtrl: return "/start remote ctrl"
+            case let .registerRemoteCtrl(oob): return "/register remote ctrl \(oob.caFingerprint)"
+            case let .acceptRemoteCtrl(rcId): return "/accept remote ctrl \(rcId)"
+            case let .rejectRemoteCtrl(rcId): return "/reject remote ctrl \(rcId)"
+            case .listRemoteCtrls: return "/list remote ctrls"
+            case .stopRemoteCtrl: return "/stop remote ctrl"
+            case let .deleteRemoteCtrl(rcId): return "/delete remote ctrl \(rcId)"
             case .showVersion: return "/version"
             case let .string(str): return str
             }
@@ -367,6 +381,13 @@ public enum ChatCommand {
             case .receiveFile: return "receiveFile"
             case .setFileToReceive: return "setFileToReceive"
             case .cancelFile: return "cancelFile"
+            case .startRemoteCtrl: return "startRemoteCtrl"
+            case .registerRemoteCtrl: return "registerRemoteCtrl"
+            case .listRemoteCtrls: return "listRemoteCtrls"
+            case .acceptRemoteCtrl: return "acceptRemoteCtrl"
+            case .rejectRemoteCtrl: return "rejectRemoteCtrl"
+            case .stopRemoteCtrl: return "stopRemoteCtrl"
+            case .deleteRemoteCtrl: return "deleteRemoteCtrl"
             case .showVersion: return "showVersion"
             case .string: return "console command"
             }
@@ -563,6 +584,13 @@ public enum ChatResponse: Decodable, Error {
     case ntfMessages(user_: User?, connEntity: ConnectionEntity?, msgTs: Date?, ntfMessages: [NtfMsgInfo])
     case newContactConnection(user: UserRef, connection: PendingContactConnection)
     case contactConnectionDeleted(user: UserRef, connection: PendingContactConnection)
+    case remoteCtrlList(remoteCtrls: [RemoteCtrlInfo])
+    case remoteCtrlRegistered(remoteCtrlId: Int64)
+    case remoteCtrlAnnounce(fingerprint: String)
+    case remoteCtrlFound(remoteCtrl: RemoteCtrl)
+    case remoteCtrlConnecting(remoteCtrlId: Int64, displayName: String)
+    case remoteCtrlConnected(remoteCtrlId: Int64, displayName: String)
+    case remoteCtrlStopped
     case versionInfo(versionInfo: CoreVersionInfo, chatMigrations: [UpMigration], agentMigrations: [UpMigration])
     case cmdOk(user: UserRef?)
     case chatCmdError(user_: UserRef?, chatError: ChatError)
@@ -699,6 +727,13 @@ public enum ChatResponse: Decodable, Error {
             case .ntfMessages: return "ntfMessages"
             case .newContactConnection: return "newContactConnection"
             case .contactConnectionDeleted: return "contactConnectionDeleted"
+            case .remoteCtrlList: return "remoteCtrlList"
+            case .remoteCtrlRegistered: return "remoteCtrlRegistered"
+            case .remoteCtrlAnnounce: return "remoteCtrlAnnounce"
+            case .remoteCtrlFound: return "remoteCtrlFound"
+            case .remoteCtrlConnecting: return "remoteCtrlConnecting"
+            case .remoteCtrlConnected: return "remoteCtrlConnected"
+            case .remoteCtrlStopped: return "remoteCtrlStopped"
             case .versionInfo: return "versionInfo"
             case .cmdOk: return "cmdOk"
             case .chatCmdError: return "chatCmdError"
@@ -838,6 +873,13 @@ public enum ChatResponse: Decodable, Error {
             case let .ntfMessages(u, connEntity, msgTs, ntfMessages): return withUser(u, "connEntity: \(String(describing: connEntity))\nmsgTs: \(String(describing: msgTs))\nntfMessages: \(String(describing: ntfMessages))")
             case let .newContactConnection(u, connection): return withUser(u, String(describing: connection))
             case let .contactConnectionDeleted(u, connection): return withUser(u, String(describing: connection))
+            case let .remoteCtrlList(remoteCtrls): return String(describing: remoteCtrls)
+            case let .remoteCtrlRegistered(rcId): return "remote ctrl ID: \(rcId)"
+            case let .remoteCtrlAnnounce(fingerprint): return "fingerprint: \(fingerprint)"
+            case let .remoteCtrlFound(remoteCtrl): return "remote ctrl: \(String(describing: remoteCtrl))"
+            case let .remoteCtrlConnecting(rcId, displayName): return "remote ctrl ID: \(rcId)\nhost displayName: \(displayName)"
+            case let .remoteCtrlConnected(rcId, displayName): return "remote ctrl ID: \(rcId)\nhost displayName: \(displayName)"
+            case .remoteCtrlStopped: return noDetails
             case let .versionInfo(versionInfo, chatMigrations, agentMigrations): return "\(String(describing: versionInfo))\n\nchat migrations: \(chatMigrations.map(\.upName))\n\nagent migrations: \(agentMigrations.map(\.upName))"
             case .cmdOk: return noDetails
             case let .chatCmdError(u, chatError): return withUser(u, String(describing: chatError))
@@ -1461,6 +1503,23 @@ public enum NotificationPreviewMode: String, SelectableItem {
     public static var values: [NotificationPreviewMode] = [.message, .contact, .hidden]
 }
 
+public struct RemoteCtrlOOB {
+    public var caFingerprint: String
+}
+
+public struct RemoteCtrlInfo: Decodable {
+    public var remoteCtrlId: Int64
+    public var displayName: String
+    public var sessionActive: Bool
+}
+
+public struct RemoteCtrl: Decodable {
+    var remoteCtrlId: Int64
+    var displayName: String
+    var fingerprint: String
+    var accepted: Bool?
+}
+
 public struct CoreVersionInfo: Decodable {
     public var version: String
     public var simplexmqVersion: String
@@ -1488,6 +1547,7 @@ public enum ChatError: Decodable {
     case errorAgent(agentError: AgentErrorType)
     case errorStore(storeError: StoreError)
     case errorDatabase(databaseError: DatabaseError)
+    case errorRemoteCtrl(remoteCtrlError: RemoteCtrlError)
     case invalidJSON(json: String)
 }
 
@@ -1739,3 +1799,15 @@ public enum ArchiveError: Decodable {
     case `import`(chatError: ChatError)
     case importFile(file: String, chatError: ChatError)
 }
+
+public enum RemoteCtrlError: Decodable {
+  case missing(remoteCtrlId: Int64)
+  case inactive
+  case busy
+  case timeout
+  case disconnected(remoteCtrlId: Int64, reason: String)
+  case connectionLost(remoteCtrlId: Int64, reason: String)
+  case certificateExpired(remoteCtrlId: Int64)
+  case certificateUntrusted(remoteCtrlId: Int64)
+  case badFingerprint
+}
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
index 9d726c620..9ab6060fe 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
@@ -1938,8 +1938,8 @@ sealed class CC {
   class StartRemoteHost(val remoteHostId: Long): CC()
   class StopRemoteHost(val remoteHostId: Long): CC()
   class DeleteRemoteHost(val remoteHostId: Long): CC()
-  class RegisterRemoteCtrl(val remoteCtrlOOB: RemoteCtrlOOB): CC()
   class StartRemoteCtrl(): CC()
+  class RegisterRemoteCtrl(val remoteCtrlOOB: RemoteCtrlOOB): CC()
   class ListRemoteCtrls(): CC()
   class AcceptRemoteCtrl(val remoteCtrlId: Long): CC()
   class RejectRemoteCtrl(val remoteCtrlId: Long): CC()
@@ -2167,8 +2167,8 @@ sealed class CC {
     is StartRemoteHost -> "startRemoteHost"
     is StopRemoteHost -> "stopRemoteHost"
     is DeleteRemoteHost -> "deleteRemoteHost"
-    is RegisterRemoteCtrl -> "registerRemoteCtrl"
     is StartRemoteCtrl -> "startRemoteCtrl"
+    is RegisterRemoteCtrl -> "registerRemoteCtrl"
     is ListRemoteCtrls -> "listRemoteCtrls"
     is AcceptRemoteCtrl -> "acceptRemoteCtrl"
     is RejectRemoteCtrl -> "rejectRemoteCtrl"
@@ -3483,30 +3483,24 @@ sealed class CR {
   @Serializable @SerialName("callEnded") class CallEnded(val user: UserRef, val contact: Contact): CR()
   @Serializable @SerialName("newContactConnection") class NewContactConnection(val user: UserRef, val connection: PendingContactConnection): CR()
   @Serializable @SerialName("contactConnectionDeleted") class ContactConnectionDeleted(val user: UserRef, val connection: PendingContactConnection): CR()
+  // remote events (desktop)
+  @Serializable @SerialName("remoteHostCreated") class RemoteHostCreated(val remoteHostId: Long, val oobData: RemoteCtrlOOB): CR()
+  @Serializable @SerialName("remoteHostList") class RemoteHostList(val remoteHosts: List<RemoteHostInfo>): CR()
+  @Serializable @SerialName("remoteHostConnected") class RemoteHostConnected(val remoteHostId: Long): CR()
+  @Serializable @SerialName("remoteHostStopped") class RemoteHostStopped(val remoteHostId: Long): CR()
+  // remote events (mobile)
+  @Serializable @SerialName("remoteCtrlList") class RemoteCtrlList(val remoteCtrls: List<RemoteCtrlInfo>): CR()
+  @Serializable @SerialName("remoteCtrlRegistered") class RemoteCtrlRegistered(val remoteCtrlId: Long): CR()
+  @Serializable @SerialName("remoteCtrlAnnounce") class RemoteCtrlAnnounce(val fingerprint: String): CR()
+  @Serializable @SerialName("remoteCtrlFound") class RemoteCtrlFound(val remoteCtrl: RemoteCtrl): CR()
+  @Serializable @SerialName("remoteCtrlConnecting") class RemoteCtrlConnecting(val remoteCtrlId: Long, val displayName: String): CR()
+  @Serializable @SerialName("remoteCtrlConnected") class RemoteCtrlConnected(val remoteCtrlId: Long, val displayName: String): CR()
+  @Serializable @SerialName("remoteCtrlStopped") class RemoteCtrlStopped(): CR()
   @Serializable @SerialName("versionInfo") class VersionInfo(val versionInfo: CoreVersionInfo, val chatMigrations: List<UpMigration>, val agentMigrations: List<UpMigration>): CR()
   @Serializable @SerialName("cmdOk") class CmdOk(val user: UserRef?): CR()
   @Serializable @SerialName("chatCmdError") class ChatCmdError(val user_: UserRef?, val chatError: ChatError): CR()
   @Serializable @SerialName("chatError") class ChatRespError(val user_: UserRef?, val chatError: ChatError): CR()
   @Serializable @SerialName("archiveImported") class ArchiveImported(val archiveErrors: List<ArchiveError>): CR()
-  // remote events (desktop)
-  @Serializable @SerialName("remoteHostCreated") class RemoteHostCreated(val remoteHostId: Long, val oobData: RemoteCtrlOOB): CR()
-  @Serializable @SerialName("remoteHostList") class RemoteHostList(val remoteHosts: List<RemoteHostInfo>): CR()
-  @Serializable @SerialName("remoteHostStarted") class RemoteHostStarted(val remoteHostId: Long): CR()
-  @Serializable @SerialName("remoteHostConnected") class RemoteHostConnected(val remoteHostId: Long): CR()
-  @Serializable @SerialName("remoteHostStopped") class RemoteHostStopped(val remoteHostId: Long): CR()
-  @Serializable @SerialName("remoteHostDeleted") class RemoteHostDeleted(val remoteHostId: Long): CR()
-  // remote events (mobile)
-  @Serializable @SerialName("remoteCtrlList") class RemoteCtrlList(val remoteCtrls: List<RemoteCtrlInfo>): CR()
-  @Serializable @SerialName("remoteCtrlRegistered") class RemoteCtrlRegistered(val remoteCtrlId: Long): CR()
-  @Serializable @SerialName("remoteCtrlStarted") class RemoteCtrlStarted(): CR()
-  @Serializable @SerialName("remoteCtrlAnnounce") class RemoteCtrlAnnounce(val fingerprint: String): CR()
-  @Serializable @SerialName("remoteCtrlFound") class RemoteCtrlFound(val remoteCtrl: RemoteCtrl): CR()
-  @Serializable @SerialName("remoteCtrlAccepted") class RemoteCtrlAccepted(val remoteCtrlId: Long): CR()
-  @Serializable @SerialName("remoteCtrlRejected") class RemoteCtrlRejected(val remoteCtrlId: Long): CR()
-  @Serializable @SerialName("remoteCtrlConnecting") class RemoteCtrlConnecting(val remoteCtrlId: Long, val displayName: String): CR()
-  @Serializable @SerialName("remoteCtrlConnected") class RemoteCtrlConnected(val remoteCtrlId: Long, val displayName: String): CR()
-  @Serializable @SerialName("remoteCtrlStopped") class RemoteCtrlStopped(): CR()
-  @Serializable @SerialName("remoteCtrlDeleted") class RemoteCtrlDeleted(val remoteCtrlId: Long): CR()
   // general
   @Serializable class Response(val type: String, val json: String): CR()
   @Serializable class Invalid(val str: String): CR()
@@ -3632,28 +3626,22 @@ sealed class CR {
     is CallEnded -> "callEnded"
     is NewContactConnection -> "newContactConnection"
     is ContactConnectionDeleted -> "contactConnectionDeleted"
+    is RemoteHostCreated -> "remoteHostCreated"
+    is RemoteHostList -> "remoteHostList"
+    is RemoteHostConnected -> "remoteHostConnected"
+    is RemoteHostStopped -> "remoteHostStopped"
+    is RemoteCtrlList -> "remoteCtrlList"
+    is RemoteCtrlRegistered -> "remoteCtrlRegistered"
+    is RemoteCtrlAnnounce -> "remoteCtrlAnnounce"
+    is RemoteCtrlFound -> "remoteCtrlFound"
+    is RemoteCtrlConnecting -> "remoteCtrlConnecting"
+    is RemoteCtrlConnected -> "remoteCtrlConnected"
+    is RemoteCtrlStopped -> "remoteCtrlStopped"
     is VersionInfo -> "versionInfo"
     is CmdOk -> "cmdOk"
     is ChatCmdError -> "chatCmdError"
     is ChatRespError -> "chatError"
     is ArchiveImported -> "archiveImported"
-    is RemoteHostCreated -> "remoteHostCreated"
-    is RemoteHostList -> "remoteHostList"
-    is RemoteHostStarted -> "remoteHostStarted"
-    is RemoteHostConnected -> "remoteHostConnected"
-    is RemoteHostStopped -> "remoteHostStopped"
-    is RemoteHostDeleted -> "remoteHostDeleted"
-    is RemoteCtrlList -> "remoteCtrlList"
-    is RemoteCtrlRegistered -> "remoteCtrlRegistered"
-    is RemoteCtrlStarted -> "remoteCtrlStarted"
-    is RemoteCtrlAnnounce -> "remoteCtrlAnnounce"
-    is RemoteCtrlFound -> "remoteCtrlFound"
-    is RemoteCtrlAccepted -> "remoteCtrlAccepted"
-    is RemoteCtrlRejected -> "remoteCtrlRejected"
-    is RemoteCtrlConnecting -> "remoteCtrlConnecting"
-    is RemoteCtrlConnected -> "remoteCtrlConnected"
-    is RemoteCtrlStopped -> "remoteCtrlStopped"
-    is RemoteCtrlDeleted -> "remoteCtrlDeleted"
     is Response -> "* $type"
     is Invalid -> "* invalid json"
   }
@@ -3779,6 +3767,17 @@ sealed class CR {
     is CallEnded -> withUser(user, "contact: ${contact.id}")
     is NewContactConnection -> withUser(user, json.encodeToString(connection))
     is ContactConnectionDeleted -> withUser(user, json.encodeToString(connection))
+    is RemoteHostCreated -> "remote host ID: $remoteHostId\noobData ${json.encodeToString(oobData)}"
+    is RemoteHostList -> "remote hosts: ${json.encodeToString(remoteHosts)}"
+    is RemoteHostConnected -> "remote host ID: $remoteHostId"
+    is RemoteHostStopped -> "remote host ID: $remoteHostId"
+    is RemoteCtrlList -> json.encodeToString(remoteCtrls)
+    is RemoteCtrlRegistered -> "remote ctrl ID: $remoteCtrlId"
+    is RemoteCtrlAnnounce -> "fingerprint: $fingerprint"
+    is RemoteCtrlFound -> "remote ctrl: ${json.encodeToString(remoteCtrl)}"
+    is RemoteCtrlConnecting -> "remote ctrl ID: $remoteCtrlId\nhost displayName: $displayName"
+    is RemoteCtrlConnected -> "remote ctrl ID: $remoteCtrlId\nhost displayName: $displayName"
+    is RemoteCtrlStopped -> ""
     is VersionInfo -> "version ${json.encodeToString(versionInfo)}\n\n" +
         "chat migrations: ${json.encodeToString(chatMigrations.map { it.upName })}\n\n" +
         "agent migrations: ${json.encodeToString(agentMigrations.map { it.upName })}"
@@ -3786,23 +3785,6 @@ sealed class CR {
     is ChatCmdError -> withUser(user_, chatError.string)
     is ChatRespError -> withUser(user_, chatError.string)
     is ArchiveImported -> "${archiveErrors.map { it.string } }"
-    is RemoteHostCreated -> "remote host ID: $remoteHostId\noobData ${json.encodeToString(oobData)}"
-    is RemoteHostList -> "remote hosts: ${json.encodeToString(remoteHosts)}"
-    is RemoteHostStarted -> "remote host $remoteHostId"
-    is RemoteHostConnected -> "remote host ID: $remoteHostId"
-    is RemoteHostStopped -> "remote host ID: $remoteHostId"
-    is RemoteHostDeleted -> "remote host ID: $remoteHostId"
-    is RemoteCtrlList -> json.encodeToString(remoteCtrls)
-    is RemoteCtrlRegistered -> "remote ctrl ID: $remoteCtrlId"
-    is RemoteCtrlStarted -> ""
-    is RemoteCtrlAnnounce -> "fingerprint: $fingerprint"
-    is RemoteCtrlFound -> "remote ctrl: ${json.encodeToString(remoteCtrl)}"
-    is RemoteCtrlAccepted -> "remote ctrl ID: $remoteCtrlId"
-    is RemoteCtrlRejected -> "remote ctrl ID: $remoteCtrlId"
-    is RemoteCtrlConnecting -> "remote ctrl ID: $remoteCtrlId\nhost displayName: $displayName"
-    is RemoteCtrlConnected -> "remote ctrl ID: $remoteCtrlId\nhost displayName: $displayName"
-    is RemoteCtrlStopped -> ""
-    is RemoteCtrlDeleted -> "remote ctrl ID: $remoteCtrlId"
     is Response -> json
     is Invalid -> str
   }
@@ -3948,16 +3930,16 @@ sealed class ChatError {
     is ChatErrorAgent -> "agent ${agentError.string}"
     is ChatErrorStore -> "store ${storeError.string}"
     is ChatErrorDatabase -> "database ${databaseError.string}"
-    is ChatErrorRemoteCtrl -> "remoteCtrl ${remoteCtrlError.string}"
     is ChatErrorRemoteHost -> "remoteHost ${remoteHostError.string}"
+    is ChatErrorRemoteCtrl -> "remoteCtrl ${remoteCtrlError.string}"
     is ChatErrorInvalidJSON -> "invalid json ${json}"
   }
   @Serializable @SerialName("error") class ChatErrorChat(val errorType: ChatErrorType): ChatError()
   @Serializable @SerialName("errorAgent") class ChatErrorAgent(val agentError: AgentErrorType): ChatError()
   @Serializable @SerialName("errorStore") class ChatErrorStore(val storeError: StoreError): ChatError()
   @Serializable @SerialName("errorDatabase") class ChatErrorDatabase(val databaseError: DatabaseError): ChatError()
-  @Serializable @SerialName("errorRemoteCtrl") class ChatErrorRemoteCtrl(val remoteCtrlError: RemoteCtrlError): ChatError()
   @Serializable @SerialName("errorRemoteHost") class ChatErrorRemoteHost(val remoteHostError: RemoteHostError): ChatError()
+  @Serializable @SerialName("errorRemoteCtrl") class ChatErrorRemoteCtrl(val remoteCtrlError: RemoteCtrlError): ChatError()
   @Serializable @SerialName("invalidJSON") class ChatErrorInvalidJSON(val json: String): ChatError()
 }
 
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 3e91bd621..454e87ef5 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1891,18 +1891,18 @@ processChatCommand = \case
     let pref = uncurry TimedMessagesGroupPreference $ maybe (FEOff, Just 86400) (\ttl -> (FEOn, Just ttl)) ttl_
     updateGroupProfileByName gName $ \p ->
       p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
-  CreateRemoteHost -> createRemoteHost
-  ListRemoteHosts -> listRemoteHosts
-  StartRemoteHost rh -> startRemoteHost rh
-  StopRemoteHost rh -> closeRemoteHostSession rh
-  DeleteRemoteHost rh -> deleteRemoteHost rh
-  StartRemoteCtrl -> startRemoteCtrl (execChatCommand Nothing)
-  AcceptRemoteCtrl rc -> acceptRemoteCtrl rc
-  RejectRemoteCtrl rc -> rejectRemoteCtrl rc
-  StopRemoteCtrl -> stopRemoteCtrl
-  RegisterRemoteCtrl oob -> registerRemoteCtrl oob
-  ListRemoteCtrls -> listRemoteCtrls
-  DeleteRemoteCtrl rc -> deleteRemoteCtrl rc
+  CreateRemoteHost -> uncurry CRRemoteHostCreated <$> createRemoteHost
+  ListRemoteHosts -> CRRemoteHostList <$> listRemoteHosts
+  StartRemoteHost rh -> startRemoteHost rh >> ok_
+  StopRemoteHost rh -> closeRemoteHostSession rh >> ok_
+  DeleteRemoteHost rh -> deleteRemoteHost rh >> ok_
+  StartRemoteCtrl -> startRemoteCtrl (execChatCommand Nothing) >> ok_
+  AcceptRemoteCtrl rc -> acceptRemoteCtrl rc >> ok_
+  RejectRemoteCtrl rc -> rejectRemoteCtrl rc >> ok_
+  StopRemoteCtrl -> stopRemoteCtrl >> ok_
+  RegisterRemoteCtrl oob -> CRRemoteCtrlRegistered <$> registerRemoteCtrl oob
+  ListRemoteCtrls -> CRRemoteCtrlList <$> listRemoteCtrls
+  DeleteRemoteCtrl rc -> deleteRemoteCtrl rc >> ok_
   QuitChat -> liftIO exitSuccess
   ShowVersion -> do
     let versionInfo = coreVersionInfo $(simplexmqCommitQ)
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index e4085ca79..5448f4960 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -425,8 +425,8 @@ data ChatCommand
   -- | SwitchRemoteHost (Maybe RemoteHostId) -- ^ Switch current remote host
   | StopRemoteHost RemoteHostId -- ^ Shut down a running session
   | DeleteRemoteHost RemoteHostId -- ^ Unregister remote host and remove its data
-  | RegisterRemoteCtrl RemoteCtrlOOB -- ^ Register OOB data for satellite discovery and handshake
   | StartRemoteCtrl -- ^ Start listening for announcements from all registered controllers
+  | RegisterRemoteCtrl RemoteCtrlOOB -- ^ Register OOB data for satellite discovery and handshake
   | ListRemoteCtrls
   | AcceptRemoteCtrl RemoteCtrlId -- ^ Accept discovered data and store confirmation
   | RejectRemoteCtrl RemoteCtrlId -- ^ Reject and blacklist discovered data
@@ -631,21 +631,15 @@ data ChatResponse
   | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
   | CRRemoteHostCreated {remoteHostId :: RemoteHostId, oobData :: RemoteCtrlOOB}
   | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]} -- XXX: RemoteHostInfo is mostly concerned with session setup
-  | CRRemoteHostStarted {remoteHostId :: RemoteHostId}
   | CRRemoteHostConnected {remoteHostId :: RemoteHostId}
   | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
-  | CRRemoteHostDeleted {remoteHostId :: RemoteHostId}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlRegistered {remoteCtrlId :: RemoteCtrlId}
-  | CRRemoteCtrlStarted
   | CRRemoteCtrlAnnounce {fingerprint :: C.KeyHash} -- unregistered fingerprint, needs confirmation
   | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrl} -- registered fingerprint, may connect
-  | CRRemoteCtrlAccepted {remoteCtrlId :: RemoteCtrlId}
-  | CRRemoteCtrlRejected {remoteCtrlId :: RemoteCtrlId}
   | CRRemoteCtrlConnecting {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
   | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
   | CRRemoteCtrlStopped
-  | CRRemoteCtrlDeleted {remoteCtrlId :: RemoteCtrlId}
   | CRSQLResult {rows :: [Text]}
   | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
   | CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks}
@@ -667,21 +661,15 @@ allowRemoteEvent :: ChatResponse -> Bool
 allowRemoteEvent = \case
   CRRemoteHostCreated {} -> False
   CRRemoteHostList {} -> False
-  CRRemoteHostStarted {} -> False
   CRRemoteHostConnected {} -> False
   CRRemoteHostStopped {} -> False
-  CRRemoteHostDeleted {} -> False
   CRRemoteCtrlList {} -> False
   CRRemoteCtrlRegistered {} -> False
-  CRRemoteCtrlStarted {} -> False
   CRRemoteCtrlAnnounce {} -> False
   CRRemoteCtrlFound {} -> False
-  CRRemoteCtrlAccepted {} -> False
-  CRRemoteCtrlRejected {} -> False
   CRRemoteCtrlConnecting {} -> False
   CRRemoteCtrlConnected {} -> False
   CRRemoteCtrlStopped {} -> False
-  CRRemoteCtrlDeleted {} -> False
   _ -> True
 
 logResponseToFile :: ChatResponse -> Bool
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 26d4f4bfd..37283511f 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -79,21 +79,20 @@ withRemoteHost remoteHostId action =
     Nothing -> throwError $ ChatErrorRemoteHost remoteHostId RHMissing
     Just rh -> action rh
 
-startRemoteHost :: (ChatMonad m) => RemoteHostId -> m ChatResponse
+startRemoteHost :: (ChatMonad m) => RemoteHostId -> m ()
 startRemoteHost remoteHostId = do
   asks remoteHostSessions >>= atomically . TM.lookup remoteHostId >>= \case
     Just _ -> throwError $ ChatErrorRemoteHost remoteHostId RHBusy
     Nothing -> withRemoteHost remoteHostId $ \rh -> do
       announcer <- async $ run rh
       chatModifyVar remoteHostSessions $ M.insert remoteHostId RemoteHostSessionStarting {announcer}
-      pure CRRemoteHostStarted {remoteHostId}
   where
     cleanup finished = do
       logInfo "Remote host http2 client fininshed"
       atomically $ writeTVar finished True
       M.lookup remoteHostId <$> chatReadVar remoteHostSessions >>= \case
         Nothing -> logInfo $ "Session already closed for remote host " <> tshow remoteHostId
-        Just _ -> closeRemoteHostSession remoteHostId >>= toView
+        Just _ -> closeRemoteHostSession remoteHostId >> toView (CRRemoteHostStopped remoteHostId)
     run RemoteHost {storePath, caKey, caCert} = do
       finished <- newTVarIO False
       let parent = (C.signatureKeyPair caKey, caCert)
@@ -142,42 +141,41 @@ pollRemote finished http path action = loop
       readTVarIO finished >>= (`unless` loop)
     req = HTTP2Client.requestNoBody "GET" path mempty
 
-closeRemoteHostSession :: (ChatMonad m) => RemoteHostId -> m ChatResponse
+closeRemoteHostSession :: (ChatMonad m) => RemoteHostId -> m ()
 closeRemoteHostSession remoteHostId = withRemoteHostSession remoteHostId $ \session -> do
   logInfo $ "Closing remote host session for " <> tshow remoteHostId
   liftIO $ cancelRemoteHostSession session
   chatWriteVar currentRemoteHost Nothing
   chatModifyVar remoteHostSessions $ M.delete remoteHostId
-  pure CRRemoteHostStopped {remoteHostId}
 
 cancelRemoteHostSession :: (MonadUnliftIO m) => RemoteHostSession -> m ()
 cancelRemoteHostSession = \case
   RemoteHostSessionStarting {announcer} -> cancel announcer
   RemoteHostSessionStarted {ctrlClient} -> liftIO $ HTTP2.closeHTTP2Client ctrlClient
 
-createRemoteHost :: (ChatMonad m) => m ChatResponse
+createRemoteHost :: (ChatMonad m) => m (RemoteHostId, RemoteCtrlOOB)
 createRemoteHost = do
   let displayName = "TODO" -- you don't have remote host name here, it will be passed from remote host
   ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) displayName
   storePath <- liftIO randomStorePath
   remoteHostId <- withStore' $ \db -> insertRemoteHost db storePath displayName caKey caCert
   let oobData = RemoteCtrlOOB {caFingerprint = C.certificateFingerprint caCert}
-  pure CRRemoteHostCreated {remoteHostId, oobData}
+  pure (remoteHostId, oobData)
 
 -- | Generate a random 16-char filepath without / in it by using base64url encoding.
 randomStorePath :: IO FilePath
 randomStorePath = B.unpack . B64U.encode <$> getRandomBytes 12
 
-listRemoteHosts :: (ChatMonad m) => m ChatResponse
+listRemoteHosts :: (ChatMonad m) => m [RemoteHostInfo]
 listRemoteHosts = do
   stored <- withStore' getRemoteHosts
   active <- chatReadVar remoteHostSessions
-  pure $ CRRemoteHostList $ do
+  pure $ do
     RemoteHost {remoteHostId, storePath, displayName} <- stored
     let sessionActive = M.member remoteHostId active
     pure RemoteHostInfo {remoteHostId, storePath, displayName, sessionActive}
 
-deleteRemoteHost :: (ChatMonad m) => RemoteHostId -> m ChatResponse
+deleteRemoteHost :: (ChatMonad m) => RemoteHostId -> m ()
 deleteRemoteHost remoteHostId = withRemoteHost remoteHostId $ \RemoteHost {storePath} -> do
   chatReadVar filesFolder >>= \case
     Just baseDir -> do
@@ -185,7 +183,6 @@ deleteRemoteHost remoteHostId = withRemoteHost remoteHostId $ \RemoteHost {store
       logError $ "TODO: remove " <> tshow hostStore
     Nothing -> logWarn "Local file store not available while deleting remote host"
   withStore' $ \db -> deleteRemoteHostRecord db remoteHostId
-  pure CRRemoteHostDeleted {remoteHostId}
 
 processRemoteCommand :: (ChatMonad m) => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
 processRemoteCommand RemoteHostSessionStarting {} _ = pure . CRChatError Nothing . ChatError $ CEInternalError "sending remote commands before session started"
@@ -393,7 +390,7 @@ processControllerRequest execChatCommand HTTP2.HTTP2Request {request, reqBody, s
 
 -- * ChatRequest handlers
 
-startRemoteCtrl :: (ChatMonad m) => (ByteString -> m ChatResponse) -> m ChatResponse
+startRemoteCtrl :: (ChatMonad m) => (ByteString -> m ChatResponse) -> m ()
 startRemoteCtrl execChatCommand =
   chatReadVar remoteCtrlSession >>= \case
     Just _busy -> throwError $ ChatErrorRemoteCtrl RCEBusy
@@ -416,7 +413,6 @@ startRemoteCtrl execChatCommand =
           chatWriteVar remoteCtrlSession Nothing
           toView CRRemoteCtrlStopped
       chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted, remoteOutputQ}
-      pure CRRemoteCtrlStarted
 
 discoverRemoteCtrls :: (ChatMonad m) => TM.TMap C.KeyHash TransportHost -> m ()
 discoverRemoteCtrls discovered = Discovery.withListener go
@@ -445,33 +441,32 @@ discoverRemoteCtrls discovered = Discovery.withListener go
                     Just RemoteCtrlSession {accepted} -> atomically $ void $ tryPutTMVar accepted remoteCtrlId -- previously accepted controller, connect automatically
         _nonV4 -> go sock
 
-registerRemoteCtrl :: (ChatMonad m) => RemoteCtrlOOB -> m ChatResponse
+registerRemoteCtrl :: (ChatMonad m) => RemoteCtrlOOB -> m RemoteCtrlId
 registerRemoteCtrl RemoteCtrlOOB {caFingerprint} = do
   let displayName = "TODO" -- maybe include into OOB data
   remoteCtrlId <- withStore' $ \db -> insertRemoteCtrl db displayName caFingerprint
-  pure $ CRRemoteCtrlRegistered {remoteCtrlId}
+  pure remoteCtrlId
 
-listRemoteCtrls :: (ChatMonad m) => m ChatResponse
+listRemoteCtrls :: (ChatMonad m) => m [RemoteCtrlInfo]
 listRemoteCtrls = do
   stored <- withStore' getRemoteCtrls
   active <-
     chatReadVar remoteCtrlSession >>= \case
       Nothing -> pure Nothing
       Just RemoteCtrlSession {accepted} -> atomically (tryReadTMVar accepted)
-  pure $ CRRemoteCtrlList $ do
+  pure $ do
     RemoteCtrl {remoteCtrlId, displayName} <- stored
     let sessionActive = active == Just remoteCtrlId
     pure RemoteCtrlInfo {remoteCtrlId, displayName, sessionActive}
 
-acceptRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
+acceptRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ()
 acceptRemoteCtrl remoteCtrlId = do
   withStore' $ \db -> markRemoteCtrlResolution db remoteCtrlId True
   chatReadVar remoteCtrlSession >>= \case
     Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
     Just RemoteCtrlSession {accepted} -> atomically . void $ tryPutTMVar accepted remoteCtrlId -- the remote host can now proceed with connection
-  pure $ CRRemoteCtrlAccepted {remoteCtrlId}
 
-rejectRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
+rejectRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ()
 rejectRemoteCtrl remoteCtrlId = do
   withStore' $ \db -> markRemoteCtrlResolution db remoteCtrlId False
   chatReadVar remoteCtrlSession >>= \case
@@ -479,9 +474,8 @@ rejectRemoteCtrl remoteCtrlId = do
     Just RemoteCtrlSession {discoverer, supervisor} -> do
       cancel discoverer
       cancel supervisor
-  pure $ CRRemoteCtrlRejected {remoteCtrlId}
 
-stopRemoteCtrl :: (ChatMonad m) => m ChatResponse
+stopRemoteCtrl :: (ChatMonad m) => m ()
 stopRemoteCtrl =
   chatReadVar remoteCtrlSession >>= \case
     Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
@@ -489,7 +483,6 @@ stopRemoteCtrl =
       cancelRemoteCtrlSession rcs $ do
         chatWriteVar remoteCtrlSession Nothing
         toView CRRemoteCtrlStopped
-      pure $ CRCmdOk Nothing
 
 cancelRemoteCtrlSession_ :: (MonadUnliftIO m) => RemoteCtrlSession -> m ()
 cancelRemoteCtrlSession_ rcs = cancelRemoteCtrlSession rcs $ pure ()
@@ -503,12 +496,10 @@ cancelRemoteCtrlSession RemoteCtrlSession {discoverer, supervisor, hostServer} c
       cancel supervisor -- supervisor is blocked until session progresses
       cleanup
 
-deleteRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ChatResponse
+deleteRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ()
 deleteRemoteCtrl remoteCtrlId =
   chatReadVar remoteCtrlSession >>= \case
-    Nothing -> do
-      withStore' $ \db -> deleteRemoteCtrlRecord db remoteCtrlId
-      pure $ CRRemoteCtrlDeleted {remoteCtrlId}
+    Nothing -> withStore' $ \db -> deleteRemoteCtrlRecord db remoteCtrlId
     Just _ -> throwError $ ChatErrorRemoteCtrl RCEBusy
 
 withRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> (RemoteCtrl -> m a) -> m a
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 1d474792a..b5dce1ba8 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -264,21 +264,15 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei
   CRNtfMessages {} -> []
   CRRemoteHostCreated rhId oobData -> ("remote host " <> sShow rhId <> " created") : viewRemoteCtrlOOBData oobData
   CRRemoteHostList hs -> viewRemoteHosts hs
-  CRRemoteHostStarted rhId -> ["remote host " <> sShow rhId <> " started"]
   CRRemoteHostConnected rhId -> ["remote host " <> sShow rhId <> " connected"]
   CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
-  CRRemoteHostDeleted rhId -> ["remote host " <> sShow rhId <> " deleted"]
   CRRemoteCtrlList cs -> viewRemoteCtrls cs
   CRRemoteCtrlRegistered rcId -> ["remote controller " <> sShow rcId <> " registered"]
-  CRRemoteCtrlStarted -> ["remote controller started"]
   CRRemoteCtrlAnnounce fingerprint -> ["remote controller announced", "connection code:", plain $ strEncode fingerprint]
   CRRemoteCtrlFound rc -> ["remote controller found:", viewRemoteCtrl rc]
-  CRRemoteCtrlAccepted rcId -> ["remote controller " <> sShow rcId <> " accepted"]
-  CRRemoteCtrlRejected rcId -> ["remote controller " <> sShow rcId <> " rejected"]
   CRRemoteCtrlConnecting rcId rcName -> ["remote controller " <> sShow rcId <> " connecting to " <> plain rcName]
   CRRemoteCtrlConnected rcId rcName -> ["remote controller " <> sShow rcId <> " connected, " <> plain rcName]
   CRRemoteCtrlStopped -> ["remote controller stopped"]
-  CRRemoteCtrlDeleted rcId -> ["remote controller " <> sShow rcId <> " deleted"]
   CRSQLResult rows -> map plain rows
   CRSlowSQLQueries {chatQueries, agentQueries} ->
     let viewQuery SlowSQLQuery {query, queryStats = SlowQueryStats {count, timeMax, timeAvg}} =
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 479febbca..68ef6788e 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -110,10 +110,10 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   desktop <## "Remote hosts:"
   desktop <## "1. TODO" -- TODO host name probably should be Maybe, as when host is created there is no name yet
   desktop ##> "/start remote host 1"
-  desktop <## "remote host 1 started"
+  desktop <## "ok"
 
   mobile ##> "/start remote ctrl"
-  mobile <## "remote controller started"
+  mobile <## "ok"
   mobile <## "remote controller announced"
   mobile <## "connection code:"
   fingerprint' <- getTermLine mobile
@@ -126,7 +126,7 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   mobile <## "Remote controllers:"
   mobile <## "1. TODO"
   mobile ##> "/accept remote ctrl 1"
-  mobile <## "remote controller 1 accepted" -- alternative scenario: accepted before controller start
+  mobile <## "ok" -- alternative scenario: accepted before controller start
   mobile <## "remote controller 1 connecting to TODO"
   mobile <## "remote controller 1 connected, TODO"
 
@@ -140,9 +140,9 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
 
   traceM "    - Shutting desktop"
   desktop ##> "/stop remote host 1"
-  desktop <## "remote host 1 stopped"
+  desktop <## "ok"
   desktop ##> "/delete remote host 1"
-  desktop <## "remote host 1 deleted"
+  desktop <## "ok"
   desktop ##> "/list remote hosts"
   desktop <## "No remote hosts"
 
@@ -151,7 +151,7 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   mobile <## "ok"
   mobile <## "remote controller stopped"
   mobile ##> "/delete remote ctrl 1"
-  mobile <## "remote controller 1 deleted"
+  mobile <## "ok"
   mobile ##> "/list remote ctrls"
   mobile <## "No remote controllers"
 
@@ -173,10 +173,10 @@ remoteCommandTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
   fingerprint <- getTermLine desktop
 
   desktop ##> "/start remote host 1"
-  desktop <## "remote host 1 started"
+  desktop <## "ok"
 
   mobile ##> "/start remote ctrl"
-  mobile <## "remote controller started"
+  mobile <## "ok"
   mobile <## "remote controller announced"
   mobile <## "connection code:"
   fingerprint' <- getTermLine mobile
@@ -184,7 +184,7 @@ remoteCommandTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
   mobile ##> ("/register remote ctrl " <> fingerprint')
   mobile <## "remote controller 1 registered"
   mobile ##> "/accept remote ctrl 1"
-  mobile <## "remote controller 1 accepted" -- alternative scenario: accepted before controller start
+  mobile <## "ok" -- alternative scenario: accepted before controller start
   mobile <## "remote controller 1 connecting to TODO"
   mobile <## "remote controller 1 connected, TODO"
   desktop <## "remote host 1 connected"
diff --git a/tests/Test.hs b/tests/Test.hs
index 071ff3791..6af51a072 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -33,7 +33,7 @@ main = do
       describe "SimpleX chat client" chatTests
       xdescribe'' "SimpleX Broadcast bot" broadcastBotTests
       xdescribe'' "SimpleX Directory service bot" directoryServiceTests
-      describe "Remote session" remoteTests
+      fdescribe "Remote session" remoteTests
   where
     testBracket test = do
       t <- getSystemTime

From f5e9bd4f8b60707f5f56df16c41a4782ab03d0f0 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 14 Oct 2023 13:10:06 +0100
Subject: [PATCH 17/69] core: add set display name (#3216)

* core: add set display name

* enable all tests
---
 src/Simplex/Chat.hs            | 12 +++++---
 src/Simplex/Chat/Controller.hs | 12 +++++---
 src/Simplex/Chat/Remote.hs     | 50 ++++++++++++++++------------------
 src/Simplex/Chat/View.hs       | 16 +++++------
 tests/RemoteTests.hs           | 16 +++++------
 tests/Test.hs                  |  2 +-
 6 files changed, 57 insertions(+), 51 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 454e87ef5..726fbdce8 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -205,6 +205,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
   remoteHostSessions <- atomically TM.empty
   remoteCtrlSession <- newTVarIO Nothing
   filesFolder <- newTVarIO optFilesFolder
@@ -236,6 +237,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
         sndFiles,
         rcvFiles,
         currentCalls,
+        localDeviceName,
         remoteHostSessions,
         remoteCtrlSession,
         config,
@@ -1891,16 +1893,17 @@ processChatCommand = \case
     let pref = uncurry TimedMessagesGroupPreference $ maybe (FEOff, Just 86400) (\ttl -> (FEOn, Just ttl)) ttl_
     updateGroupProfileByName gName $ \p ->
       p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
-  CreateRemoteHost -> uncurry CRRemoteHostCreated <$> createRemoteHost
+  SetLocalDeviceName name -> withUser $ \_ -> chatWriteVar localDeviceName name >> ok_
+  CreateRemoteHost -> CRRemoteHostCreated <$> createRemoteHost
   ListRemoteHosts -> CRRemoteHostList <$> listRemoteHosts
   StartRemoteHost rh -> startRemoteHost rh >> ok_
   StopRemoteHost rh -> closeRemoteHostSession rh >> ok_
   DeleteRemoteHost rh -> deleteRemoteHost rh >> ok_
   StartRemoteCtrl -> startRemoteCtrl (execChatCommand Nothing) >> ok_
+  RegisterRemoteCtrl oob -> CRRemoteCtrlRegistered <$> registerRemoteCtrl oob
   AcceptRemoteCtrl rc -> acceptRemoteCtrl rc >> ok_
   RejectRemoteCtrl rc -> rejectRemoteCtrl rc >> ok_
   StopRemoteCtrl -> stopRemoteCtrl >> ok_
-  RegisterRemoteCtrl oob -> CRRemoteCtrlRegistered <$> registerRemoteCtrl oob
   ListRemoteCtrls -> CRRemoteCtrlList <$> listRemoteCtrls
   DeleteRemoteCtrl rc -> deleteRemoteCtrl rc >> ok_
   QuitChat -> liftIO exitSuccess
@@ -5810,14 +5813,15 @@ chatCommandP =
       "/set disappear @" *> (SetContactTimedMessages <$> displayName <*> optional (A.space *> timedMessagesEnabledP)),
       "/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))),
       ("/incognito" <* optional (A.space *> onOffP)) $> ChatHelp HSIncognito,
+      "/set device name " *> (SetLocalDeviceName <$> textP),
       "/create remote host" $> CreateRemoteHost,
       "/list remote hosts" $> ListRemoteHosts,
       "/start remote host " *> (StartRemoteHost <$> A.decimal),
       "/stop remote host " *> (StopRemoteHost <$> A.decimal),
       "/delete remote host " *> (DeleteRemoteHost <$> A.decimal),
       "/start remote ctrl" $> StartRemoteCtrl,
-      -- TODO *** you need to pass multiple parameters here
-      "/register remote ctrl " *> (RegisterRemoteCtrl <$> (RemoteCtrlOOB <$> strP)),
+      "/register remote ctrl " *> (RegisterRemoteCtrl <$> (RemoteCtrlOOB <$> strP <* A.space <*> textP)),
+      "/_register remote ctrl " *> (RegisterRemoteCtrl <$> jsonP),
       "/list remote ctrls" $> ListRemoteCtrls,
       "/accept remote ctrl " *> (AcceptRemoteCtrl <$> A.decimal),
       "/reject remote ctrl " *> (RejectRemoteCtrl <$> A.decimal),
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 5448f4960..2a2b7cff9 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -179,6 +179,7 @@ data ChatController = ChatController
     sndFiles :: TVar (Map Int64 Handle),
     rcvFiles :: TVar (Map Int64 Handle),
     currentCalls :: TMap ContactId Call,
+    localDeviceName :: TVar Text,
     remoteHostSessions :: TMap RemoteHostId RemoteHostSession, -- All the active remote hosts
     remoteCtrlSession :: TVar (Maybe RemoteCtrlSession), -- Supervisor process for hosted controllers
     config :: ChatConfig,
@@ -419,6 +420,7 @@ data ChatCommand
   | SetUserTimedMessages Bool -- UserId (not used in UI)
   | SetContactTimedMessages ContactName (Maybe TimedMessagesEnabled)
   | SetGroupTimedMessages GroupName (Maybe Int)
+  | SetLocalDeviceName Text
   | CreateRemoteHost -- ^ Configure a new remote host
   | ListRemoteHosts
   | StartRemoteHost RemoteHostId -- ^ Start and announce a remote host
@@ -629,9 +631,9 @@ data ChatResponse
   | CRNtfMessages {user_ :: Maybe User, connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}
   | CRNewContactConnection {user :: User, connection :: PendingContactConnection}
   | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
-  | CRRemoteHostCreated {remoteHostId :: RemoteHostId, oobData :: RemoteCtrlOOB}
-  | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]} -- XXX: RemoteHostInfo is mostly concerned with session setup
-  | CRRemoteHostConnected {remoteHostId :: RemoteHostId}
+  | CRRemoteHostCreated {remoteHost :: RemoteHostInfo}
+  | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
+  | CRRemoteHostConnected {remoteHostId :: RemoteHostId} -- TODO add displayName
   | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlRegistered {remoteCtrlId :: RemoteCtrlId}
@@ -692,7 +694,8 @@ logResponseToFile = \case
   _ -> False
 
 data RemoteCtrlOOB = RemoteCtrlOOB
-  { caFingerprint :: C.KeyHash
+  { caFingerprint :: C.KeyHash,
+    displayName :: Text
   }
   deriving (Show, Generic, FromJSON)
 
@@ -702,6 +705,7 @@ data RemoteHostInfo = RemoteHostInfo
   { remoteHostId :: RemoteHostId,
     storePath :: FilePath,
     displayName :: Text,
+    remoteCtrlOOB :: RemoteCtrlOOB,
     sessionActive :: Bool
   }
   deriving (Show, Generic, FromJSON)
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 37283511f..4d031634f 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -62,7 +62,7 @@ import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), defaultHTTP2BufferSize
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HTTP2
 import qualified Simplex.Messaging.Transport.HTTP2.Server as HTTP2
-import Simplex.Messaging.Util (bshow, ifM, tshow)
+import Simplex.Messaging.Util (bshow, ifM, tshow, ($>>=))
 import System.FilePath (isPathSeparator, takeFileName, (</>))
 import UnliftIO
 import UnliftIO.Directory (createDirectoryIfMissing, getFileSize)
@@ -153,14 +153,15 @@ cancelRemoteHostSession = \case
   RemoteHostSessionStarting {announcer} -> cancel announcer
   RemoteHostSessionStarted {ctrlClient} -> liftIO $ HTTP2.closeHTTP2Client ctrlClient
 
-createRemoteHost :: (ChatMonad m) => m (RemoteHostId, RemoteCtrlOOB)
+createRemoteHost :: (ChatMonad m) => m RemoteHostInfo
 createRemoteHost = do
-  let displayName = "TODO" -- you don't have remote host name here, it will be passed from remote host
-  ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) displayName
+  let hostDisplayName = "TODO" -- you don't have remote host name here, it will be passed from remote host
+  ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) hostDisplayName
   storePath <- liftIO randomStorePath
-  remoteHostId <- withStore' $ \db -> insertRemoteHost db storePath displayName caKey caCert
-  let oobData = RemoteCtrlOOB {caFingerprint = C.certificateFingerprint caCert}
-  pure (remoteHostId, oobData)
+  remoteHostId <- withStore' $ \db -> insertRemoteHost db storePath hostDisplayName caKey caCert
+  displayName <- chatReadVar localDeviceName
+  let remoteCtrlOOB = RemoteCtrlOOB {caFingerprint = C.certificateFingerprint caCert, displayName}
+  pure RemoteHostInfo {remoteHostId, storePath, displayName, remoteCtrlOOB, sessionActive = False}
 
 -- | Generate a random 16-char filepath without / in it by using base64url encoding.
 randomStorePath :: IO FilePath
@@ -168,12 +169,14 @@ randomStorePath = B.unpack . B64U.encode <$> getRandomBytes 12
 
 listRemoteHosts :: (ChatMonad m) => m [RemoteHostInfo]
 listRemoteHosts = do
-  stored <- withStore' getRemoteHosts
   active <- chatReadVar remoteHostSessions
-  pure $ do
-    RemoteHost {remoteHostId, storePath, displayName} <- stored
-    let sessionActive = M.member remoteHostId active
-    pure RemoteHostInfo {remoteHostId, storePath, displayName, sessionActive}
+  rcName <- chatReadVar localDeviceName
+  map (rhInfo active rcName) <$> withStore' getRemoteHosts
+  where
+    rhInfo active rcName RemoteHost {remoteHostId, storePath, displayName, caCert} =
+      let sessionActive = M.member remoteHostId active
+          remoteCtrlOOB = RemoteCtrlOOB {caFingerprint = C.certificateFingerprint caCert, displayName = rcName}
+       in RemoteHostInfo {remoteHostId, storePath, displayName, remoteCtrlOOB, sessionActive}
 
 deleteRemoteHost :: (ChatMonad m) => RemoteHostId -> m ()
 deleteRemoteHost remoteHostId = withRemoteHost remoteHostId $ \RemoteHost {storePath} -> do
@@ -442,22 +445,20 @@ discoverRemoteCtrls discovered = Discovery.withListener go
         _nonV4 -> go sock
 
 registerRemoteCtrl :: (ChatMonad m) => RemoteCtrlOOB -> m RemoteCtrlId
-registerRemoteCtrl RemoteCtrlOOB {caFingerprint} = do
-  let displayName = "TODO" -- maybe include into OOB data
+registerRemoteCtrl RemoteCtrlOOB {caFingerprint, displayName} = do
   remoteCtrlId <- withStore' $ \db -> insertRemoteCtrl db displayName caFingerprint
   pure remoteCtrlId
 
 listRemoteCtrls :: (ChatMonad m) => m [RemoteCtrlInfo]
 listRemoteCtrls = do
-  stored <- withStore' getRemoteCtrls
   active <-
-    chatReadVar remoteCtrlSession >>= \case
-      Nothing -> pure Nothing
-      Just RemoteCtrlSession {accepted} -> atomically (tryReadTMVar accepted)
-  pure $ do
-    RemoteCtrl {remoteCtrlId, displayName} <- stored
-    let sessionActive = active == Just remoteCtrlId
-    pure RemoteCtrlInfo {remoteCtrlId, displayName, sessionActive}
+    chatReadVar remoteCtrlSession
+      $>>= \RemoteCtrlSession {accepted} -> atomically $ tryReadTMVar accepted
+  map (rcInfo active) <$> withStore' getRemoteCtrls
+  where
+    rcInfo active RemoteCtrl {remoteCtrlId, displayName} =
+      let sessionActive = active == Just remoteCtrlId
+       in RemoteCtrlInfo {remoteCtrlId, displayName, sessionActive}
 
 acceptRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ()
 acceptRemoteCtrl remoteCtrlId = do
@@ -479,10 +480,7 @@ stopRemoteCtrl :: (ChatMonad m) => m ()
 stopRemoteCtrl =
   chatReadVar remoteCtrlSession >>= \case
     Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
-    Just rcs -> do
-      cancelRemoteCtrlSession rcs $ do
-        chatWriteVar remoteCtrlSession Nothing
-        toView CRRemoteCtrlStopped
+    Just rcs -> cancelRemoteCtrlSession rcs $ chatWriteVar remoteCtrlSession Nothing
 
 cancelRemoteCtrlSession_ :: (MonadUnliftIO m) => RemoteCtrlSession -> m ()
 cancelRemoteCtrlSession_ rcs = cancelRemoteCtrlSession rcs $ pure ()
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index b5dce1ba8..d6826c877 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -262,7 +262,7 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei
   CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
   CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)]
   CRNtfMessages {} -> []
-  CRRemoteHostCreated rhId oobData -> ("remote host " <> sShow rhId <> " created") : viewRemoteCtrlOOBData oobData
+  CRRemoteHostCreated RemoteHostInfo {remoteHostId, remoteCtrlOOB} -> ("remote host " <> sShow remoteHostId <> " created") : viewRemoteCtrlOOBData remoteCtrlOOB
   CRRemoteHostList hs -> viewRemoteHosts hs
   CRRemoteHostConnected rhId -> ["remote host " <> sShow rhId <> " connected"]
   CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
@@ -320,14 +320,14 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei
       | otherwise = []
     ttyUserPrefix :: User -> [StyledString] -> [StyledString]
     ttyUserPrefix _ [] = []
-    ttyUserPrefix User {userId, localDisplayName = u} ss = prependFirst prefix ss
+    ttyUserPrefix User {userId, localDisplayName = u} ss
+      | null prefix = ss
+      | otherwise = prependFirst ("[" <> mconcat prefix <> "] ") ss
       where
-        prefix = if outputRH /= currentRH then r else userPrefix
-        r = case outputRH of
-          Nothing -> "[local] " <> userPrefix
-          Just rh -> "[remote: ]" <> highlight (show rh) <> "] "
-        userPrefix = if Just userId /= currentUserId then "[user: " <> highlight u <> "] " else ""
-        currentUserId = fmap (\User {userId} -> userId) user_
+        prefix = intersperse ", " $ remotePrefix <> userPrefix
+        remotePrefix = [maybe "local" (("remote: " <>) . highlight . show) outputRH | outputRH /= currentRH]
+        userPrefix = ["user: " <> highlight u | Just userId /= currentUserId]
+        currentUserId = (\User {userId = uId} -> uId) <$> user_
     ttyUser' :: Maybe User -> [StyledString] -> [StyledString]
     ttyUser' = maybe id ttyUser
     ttyUserPrefix' :: Maybe User -> [StyledString] -> [StyledString]
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 68ef6788e..5bc184580 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -120,15 +120,15 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   fingerprint' `shouldBe` fingerprint
   mobile ##> "/list remote ctrls"
   mobile <## "No remote controllers"
-  mobile ##> ("/register remote ctrl " <> fingerprint')
+  mobile ##> ("/register remote ctrl " <> fingerprint' <> " " <> "My desktop")
   mobile <## "remote controller 1 registered"
   mobile ##> "/list remote ctrls"
   mobile <## "Remote controllers:"
-  mobile <## "1. TODO"
+  mobile <## "1. My desktop"
   mobile ##> "/accept remote ctrl 1"
   mobile <## "ok" -- alternative scenario: accepted before controller start
-  mobile <## "remote controller 1 connecting to TODO"
-  mobile <## "remote controller 1 connected, TODO"
+  mobile <## "remote controller 1 connecting to My desktop"
+  mobile <## "remote controller 1 connected, My desktop"
 
   traceM "    - Session active"
   desktop ##> "/list remote hosts"
@@ -136,7 +136,7 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   desktop <## "1. TODO (active)"
   mobile ##> "/list remote ctrls"
   mobile <## "Remote controllers:"
-  mobile <## "1. TODO (active)"
+  mobile <## "1. My desktop (active)"
 
   traceM "    - Shutting desktop"
   desktop ##> "/stop remote host 1"
@@ -181,12 +181,12 @@ remoteCommandTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
   mobile <## "connection code:"
   fingerprint' <- getTermLine mobile
   fingerprint' `shouldBe` fingerprint
-  mobile ##> ("/register remote ctrl " <> fingerprint')
+  mobile ##> ("/register remote ctrl " <> fingerprint' <> " " <> "My desktop")
   mobile <## "remote controller 1 registered"
   mobile ##> "/accept remote ctrl 1"
   mobile <## "ok" -- alternative scenario: accepted before controller start
-  mobile <## "remote controller 1 connecting to TODO"
-  mobile <## "remote controller 1 connected, TODO"
+  mobile <## "remote controller 1 connecting to My desktop"
+  mobile <## "remote controller 1 connected, My desktop"
   desktop <## "remote host 1 connected"
 
   traceM "    - exchanging contacts"
diff --git a/tests/Test.hs b/tests/Test.hs
index 6af51a072..071ff3791 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -33,7 +33,7 @@ main = do
       describe "SimpleX chat client" chatTests
       xdescribe'' "SimpleX Broadcast bot" broadcastBotTests
       xdescribe'' "SimpleX Directory service bot" directoryServiceTests
-      fdescribe "Remote session" remoteTests
+      describe "Remote session" remoteTests
   where
     testBracket test = do
       t <- getSystemTime

From 41b86e07f18b0cceee3a881cfb0ce1b17cea8450 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 15 Oct 2023 00:18:04 +0100
Subject: [PATCH 18/69] core: update api (#3221)

---
 apps/ios/Shared/Model/SimpleXAPI.swift        |   4 +-
 apps/ios/SimpleXChat/APITypes.swift           |  19 ++-
 .../chat/simplex/common/model/SimpleXAPI.kt   | 149 ++++++++++++------
 src/Simplex/Chat.hs                           |   3 +-
 src/Simplex/Chat/Controller.hs                |  38 +----
 src/Simplex/Chat/Remote.hs                    |  52 +++---
 src/Simplex/Chat/Remote/Types.hs              |  32 +++-
 src/Simplex/Chat/Store/Remote.hs              |  12 +-
 src/Simplex/Chat/View.hs                      |  16 +-
 9 files changed, 199 insertions(+), 126 deletions(-)

diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift
index ad76364e9..0089fd087 100644
--- a/apps/ios/Shared/Model/SimpleXAPI.swift
+++ b/apps/ios/Shared/Model/SimpleXAPI.swift
@@ -886,9 +886,9 @@ func startRemoteCtrl() async throws {
     try await sendCommandOkResp(.startRemoteCtrl)
 }
 
-func registerRemoteCtrl(_ remoteCtrlOOB: RemoteCtrlOOB) async throws -> Int64 {
+func registerRemoteCtrl(_ remoteCtrlOOB: RemoteCtrlOOB) async throws -> RemoteCtrlInfo {
     let r = await chatSendCmd(.registerRemoteCtrl(remoteCtrlOOB: remoteCtrlOOB))
-    if case let .remoteCtrlRegistered(rcId) = r { return rcId }
+    if case let .remoteCtrlRegistered(rcInfo) = r { return rcInfo }
     throw r
 }
 
diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift
index 4b79800e1..756ab3034 100644
--- a/apps/ios/SimpleXChat/APITypes.swift
+++ b/apps/ios/SimpleXChat/APITypes.swift
@@ -117,6 +117,7 @@ public enum ChatCommand {
     case receiveFile(fileId: Int64, encrypted: Bool, inline: Bool?)
     case setFileToReceive(fileId: Int64, encrypted: Bool)
     case cancelFile(fileId: Int64)
+    case setLocalDeviceName(displayName: String)
     case startRemoteCtrl
     case registerRemoteCtrl(remoteCtrlOOB: RemoteCtrlOOB)
     case listRemoteCtrls
@@ -262,6 +263,7 @@ public enum ChatCommand {
                 return s
             case let .setFileToReceive(fileId, encrypted): return "/_set_file_to_receive \(fileId) encrypt=\(onOff(encrypted))"
             case let .cancelFile(fileId): return "/fcancel \(fileId)"
+            case let .setLocalDeviceName(displayName): return "/set device name \(displayName)"
             case .startRemoteCtrl: return "/start remote ctrl"
             case let .registerRemoteCtrl(oob): return "/register remote ctrl \(oob.caFingerprint)"
             case let .acceptRemoteCtrl(rcId): return "/accept remote ctrl \(rcId)"
@@ -381,6 +383,7 @@ public enum ChatCommand {
             case .receiveFile: return "receiveFile"
             case .setFileToReceive: return "setFileToReceive"
             case .cancelFile: return "cancelFile"
+            case .setLocalDeviceName: return "setLocalDeviceName"
             case .startRemoteCtrl: return "startRemoteCtrl"
             case .registerRemoteCtrl: return "registerRemoteCtrl"
             case .listRemoteCtrls: return "listRemoteCtrls"
@@ -585,11 +588,11 @@ public enum ChatResponse: Decodable, Error {
     case newContactConnection(user: UserRef, connection: PendingContactConnection)
     case contactConnectionDeleted(user: UserRef, connection: PendingContactConnection)
     case remoteCtrlList(remoteCtrls: [RemoteCtrlInfo])
-    case remoteCtrlRegistered(remoteCtrlId: Int64)
+    case remoteCtrlRegistered(remoteCtrl: RemoteCtrlInfo)
     case remoteCtrlAnnounce(fingerprint: String)
-    case remoteCtrlFound(remoteCtrl: RemoteCtrl)
-    case remoteCtrlConnecting(remoteCtrlId: Int64, displayName: String)
-    case remoteCtrlConnected(remoteCtrlId: Int64, displayName: String)
+    case remoteCtrlFound(remoteCtrl: RemoteCtrlInfo)
+    case remoteCtrlConnecting(remoteCtrl: RemoteCtrlInfo)
+    case remoteCtrlConnected(remoteCtrl: RemoteCtrlInfo)
     case remoteCtrlStopped
     case versionInfo(versionInfo: CoreVersionInfo, chatMigrations: [UpMigration], agentMigrations: [UpMigration])
     case cmdOk(user: UserRef?)
@@ -874,11 +877,11 @@ public enum ChatResponse: Decodable, Error {
             case let .newContactConnection(u, connection): return withUser(u, String(describing: connection))
             case let .contactConnectionDeleted(u, connection): return withUser(u, String(describing: connection))
             case let .remoteCtrlList(remoteCtrls): return String(describing: remoteCtrls)
-            case let .remoteCtrlRegistered(rcId): return "remote ctrl ID: \(rcId)"
+            case let .remoteCtrlRegistered(remoteCtrl): return String(describing: remoteCtrl)
             case let .remoteCtrlAnnounce(fingerprint): return "fingerprint: \(fingerprint)"
-            case let .remoteCtrlFound(remoteCtrl): return "remote ctrl: \(String(describing: remoteCtrl))"
-            case let .remoteCtrlConnecting(rcId, displayName): return "remote ctrl ID: \(rcId)\nhost displayName: \(displayName)"
-            case let .remoteCtrlConnected(rcId, displayName): return "remote ctrl ID: \(rcId)\nhost displayName: \(displayName)"
+            case let .remoteCtrlFound(remoteCtrl): return String(describing: remoteCtrl)
+            case let .remoteCtrlConnecting(remoteCtrl): return String(describing: remoteCtrl)
+            case let .remoteCtrlConnected(remoteCtrl): return String(describing: remoteCtrl)
             case .remoteCtrlStopped: return noDetails
             case let .versionInfo(versionInfo, chatMigrations, agentMigrations): return "\(String(describing: versionInfo))\n\nchat migrations: \(chatMigrations.map(\.upName))\n\nagent migrations: \(agentMigrations.map(\.upName))"
             case .cmdOk: return noDetails
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
index 9ab6060fe..f128fcb75 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
@@ -166,6 +166,7 @@ class AppPreferences {
   val whatsNewVersion = mkStrPreference(SHARED_PREFS_WHATS_NEW_VERSION, null)
   val lastMigratedVersionCode = mkIntPreference(SHARED_PREFS_LAST_MIGRATED_VERSION_CODE, 0)
   val customDisappearingMessageTime = mkIntPreference(SHARED_PREFS_CUSTOM_DISAPPEARING_MESSAGE_TIME, 300)
+  val deviceNameForRemoteAccess = mkStrPreference(SHARED_PREFS_DEVICE_NAME_FOR_REMOTE_ACCESS, "Desktop")
 
   private fun mkIntPreference(prefName: String, default: Int) =
     SharedPreference(
@@ -306,6 +307,7 @@ class AppPreferences {
     private const val SHARED_PREFS_WHATS_NEW_VERSION = "WhatsNewVersion"
     private const val SHARED_PREFS_LAST_MIGRATED_VERSION_CODE = "LastMigratedVersionCode"
     private const val SHARED_PREFS_CUSTOM_DISAPPEARING_MESSAGE_TIME = "CustomDisappearingMessageTime"
+    private const val SHARED_PREFS_DEVICE_NAME_FOR_REMOTE_ACCESS = "DeviceNameForRemoteAccess"
   }
 }
 
@@ -342,6 +344,11 @@ object ChatController {
       val users = listUsers()
       chatModel.users.clear()
       chatModel.users.addAll(users)
+      val remoteHosts = listRemoteHosts()
+      if (remoteHosts != null) {
+        chatModel.remoteHosts.clear()
+        chatModel.remoteHosts.addAll(remoteHosts)
+      }
       if (justStarted) {
         chatModel.currentUser.value = user
         chatModel.userCreated.value = true
@@ -432,15 +439,16 @@ object ChatController {
     }
   }
 
-  private fun recvMsg(ctrl: ChatCtrl): CR? {
+  private fun recvMsg(ctrl: ChatCtrl): APIResponse? {
     val json = chatRecvMsgWait(ctrl, MESSAGE_TIMEOUT)
     return if (json == "") {
       null
     } else {
-      val r = APIResponse.decodeStr(json).resp
+      val apiResp = APIResponse.decodeStr(json)
+      val r = apiResp.resp
       Log.d(TAG, "chatRecvMsg: ${r.responseType}")
       if (r is CR.Response || r is CR.Invalid) Log.d(TAG, "chatRecvMsg json: $json")
-      r
+      apiResp
     }
   }
 
@@ -1327,6 +1335,59 @@ object ChatController {
     }
   }
 
+  suspend fun setLocalDeviceName(displayName: String): Boolean = sendCommandOkResp(CC.SetLocalDeviceName(displayName))
+
+  suspend fun createRemoteHost(): RemoteHostInfo? {
+    val r = sendCmd(CC.CreateRemoteHost())
+    if (r is CR.RemoteHostCreated) return r.remoteHost
+    apiErrorAlert("createRemoteHost", generalGetString(MR.strings.error), r)
+    return null
+  }
+
+  suspend fun listRemoteHosts(): List<RemoteHostInfo>? {
+    val r = sendCmd(CC.ListRemoteHosts())
+    if (r is CR.RemoteHostList) return r.remoteHosts
+    apiErrorAlert("listRemoteHosts", generalGetString(MR.strings.error), r)
+    return null
+  }
+
+  suspend fun startRemoteHost(rhId: Long): Boolean = sendCommandOkResp(CC.StartRemoteHost(rhId))
+
+  suspend fun registerRemoteCtrl(oob: RemoteCtrlOOB): RemoteCtrlInfo? {
+    val r = sendCmd(CC.RegisterRemoteCtrl(oob))
+    if (r is CR.RemoteCtrlRegistered) return r.remoteCtrl
+    apiErrorAlert("registerRemoteCtrl", generalGetString(MR.strings.error), r)
+    return null
+  }
+
+  suspend fun listRemoteCtrls(): List<RemoteCtrlInfo>? {
+    val r = sendCmd(CC.ListRemoteCtrls())
+    if (r is CR.RemoteCtrlList) return r.remoteCtrls
+    apiErrorAlert("listRemoteCtrls", generalGetString(MR.strings.error), r)
+    return null
+  }
+
+  suspend fun stopRemoteHost(rhId: Long): Boolean = sendCommandOkResp(CC.StopRemoteHost(rhId))
+
+  suspend fun deleteRemoteHost(rhId: Long): Boolean = sendCommandOkResp(CC.DeleteRemoteHost(rhId))
+
+  suspend fun startRemoteCtrl(): Boolean = sendCommandOkResp(CC.StartRemoteCtrl())
+
+  suspend fun acceptRemoteCtrl(rcId: Long): Boolean = sendCommandOkResp(CC.AcceptRemoteCtrl(rcId))
+
+  suspend fun rejectRemoteCtrl(rcId: Long): Boolean = sendCommandOkResp(CC.RejectRemoteCtrl(rcId))
+
+  suspend fun stopRemoteCtrl(): Boolean = sendCommandOkResp(CC.StopRemoteCtrl())
+
+  suspend fun deleteRemoteCtrl(rcId: Long): Boolean = sendCommandOkResp(CC.DeleteRemoteCtrl(rcId))
+
+  private suspend fun sendCommandOkResp(cmd: CC): Boolean {
+    val r = sendCmd(cmd)
+    val ok = r is CR.CmdOk
+    if (!ok) apiErrorAlert(cmd.cmdType, generalGetString(MR.strings.error), r)
+    return ok
+  }
+
   suspend fun apiGetVersion(): CoreVersionInfo? {
     val r = sendCmd(CC.ShowVersion())
     return if (r is CR.VersionInfo) {
@@ -1361,14 +1422,15 @@ object ChatController {
     }
   }
 
-  fun apiErrorAlert(method: String, title: String, r: CR) {
+  private fun apiErrorAlert(method: String, title: String, r: CR) {
     val errMsg = "${r.responseType}: ${r.details}"
     Log.e(TAG, "$method bad response: $errMsg")
     AlertManager.shared.showAlertMsg(title, errMsg)
   }
 
-  suspend fun processReceivedMsg(r: CR) {
+  private suspend fun processReceivedMsg(apiResp: APIResponse) {
     lastMsgReceivedTimestamp = System.currentTimeMillis()
+    val r = apiResp.resp
     chatModel.addTerminalItem(TerminalItem.resp(r))
     when (r) {
       is CR.NewContactConnection -> {
@@ -1674,6 +1736,13 @@ object ChatController {
         chatModel.updateContactConnectionStats(r.contact, r.ratchetSyncProgress.connectionStats)
       is CR.GroupMemberRatchetSync ->
         chatModel.updateGroupMemberConnectionStats(r.groupInfo, r.member, r.ratchetSyncProgress.connectionStats)
+      is CR.RemoteHostConnected -> {
+        // update
+        chatModel.connectingRemoteHost.value = r.remoteHost
+      }
+      is CR.RemoteHostStopped -> {
+        //
+      }
       else ->
         Log.d(TAG , "unsupported event: ${r.responseType}")
     }
@@ -1933,6 +2002,7 @@ sealed class CC {
   class ApiChatUnread(val type: ChatType, val id: Long, val unreadChat: Boolean): CC()
   class ReceiveFile(val fileId: Long, val encrypted: Boolean, val inline: Boolean?): CC()
   class CancelFile(val fileId: Long): CC()
+  class SetLocalDeviceName(val displayName: String): CC()
   class CreateRemoteHost(): CC()
   class ListRemoteHosts(): CC()
   class StartRemoteHost(val remoteHostId: Long): CC()
@@ -2053,13 +2123,14 @@ sealed class CC {
     is ApiChatUnread -> "/_unread chat ${chatRef(type, id)} ${onOff(unreadChat)}"
     is ReceiveFile -> "/freceive $fileId encrypt=${onOff(encrypted)}" + (if (inline == null) "" else " inline=${onOff(inline)}")
     is CancelFile -> "/fcancel $fileId"
+    is SetLocalDeviceName -> "/set device name $displayName"
     is CreateRemoteHost -> "/create remote host"
     is ListRemoteHosts -> "/list remote hosts"
     is StartRemoteHost -> "/start remote host $remoteHostId"
     is StopRemoteHost -> "/stop remote host $remoteHostId"
     is DeleteRemoteHost -> "/delete remote host $remoteHostId"
     is StartRemoteCtrl -> "/start remote ctrl"
-    is RegisterRemoteCtrl -> "/register remote ctrl ${remoteCtrlOOB.caFingerprint}"
+    is RegisterRemoteCtrl -> "/register remote ctrl ${remoteCtrlOOB.fingerprint}"
     is AcceptRemoteCtrl -> "/accept remote ctrl $remoteCtrlId"
     is RejectRemoteCtrl -> "/reject remote ctrl $remoteCtrlId"
     is ListRemoteCtrls -> "/list remote ctrls"
@@ -2162,6 +2233,7 @@ sealed class CC {
     is ApiChatUnread -> "apiChatUnread"
     is ReceiveFile -> "receiveFile"
     is CancelFile -> "cancelFile"
+    is SetLocalDeviceName -> "setLocalDeviceName"
     is CreateRemoteHost -> "createRemoteHost"
     is ListRemoteHosts -> "listRemoteHosts"
     is StartRemoteHost -> "startRemoteHost"
@@ -3246,7 +3318,8 @@ data class RemoteCtrl (
 
 @Serializable
 data class RemoteCtrlOOB (
-  val caFingerprint: String
+  val fingerprint: String,
+  val displayName: String
 )
 
 @Serializable
@@ -3261,6 +3334,7 @@ data class RemoteHostInfo (
   val remoteHostId: Long,
   val storePath: String,
   val displayName: String,
+  val remoteCtrlOOB: RemoteCtrlOOB,
   val sessionActive: Boolean
 )
 
@@ -3277,7 +3351,7 @@ val yaml = Yaml(configuration = YamlConfiguration(
 ))
 
 @Serializable
-class APIResponse(val resp: CR, val corr: String? = null) {
+class APIResponse(val resp: CR, val remoteHostId: Long?, val corr: String? = null) {
   companion object {
     fun decodeStr(str: String): APIResponse {
       return try {
@@ -3287,48 +3361,35 @@ class APIResponse(val resp: CR, val corr: String? = null) {
           Log.d(TAG, e.localizedMessage ?: "")
           val data = json.parseToJsonElement(str).jsonObject
           val resp = data["resp"]!!.jsonObject
-          val type = resp["type"]?.jsonPrimitive?.content ?: "invalid"
+          val type = resp["type"]?.jsonPrimitive?.contentOrNull ?: "invalid"
+          val corr = data["corr"]?.toString()
+          val remoteHostId = data["remoteHostId"]?.jsonPrimitive?.longOrNull
           try {
             if (type == "apiChats") {
               val user: UserRef = json.decodeFromJsonElement(resp["user"]!!.jsonObject)
               val chats: List<Chat> = resp["chats"]!!.jsonArray.map {
                 parseChatData(it)
               }
-              return APIResponse(
-                resp = CR.ApiChats(user, chats),
-                corr = data["corr"]?.toString()
-              )
+              return APIResponse(CR.ApiChats(user, chats), remoteHostId, corr)
             } else if (type == "apiChat") {
               val user: UserRef = json.decodeFromJsonElement(resp["user"]!!.jsonObject)
               val chat = parseChatData(resp["chat"]!!)
-              return APIResponse(
-                resp = CR.ApiChat(user, chat),
-                corr = data["corr"]?.toString()
-              )
+              return APIResponse(CR.ApiChat(user, chat), remoteHostId, corr)
             } else if (type == "chatCmdError") {
               val userObject = resp["user_"]?.jsonObject
               val user = runCatching<UserRef?> { json.decodeFromJsonElement(userObject!!) }.getOrNull()
-              return APIResponse(
-                resp = CR.ChatCmdError(user, ChatError.ChatErrorInvalidJSON(json.encodeToString(resp["chatError"]))),
-                corr = data["corr"]?.toString()
-              )
+              return APIResponse(CR.ChatCmdError(user, ChatError.ChatErrorInvalidJSON(json.encodeToString(resp["chatError"]))), remoteHostId, corr)
             } else if (type == "chatError") {
               val userObject = resp["user_"]?.jsonObject
               val user = runCatching<UserRef?> { json.decodeFromJsonElement(userObject!!) }.getOrNull()
-              return APIResponse(
-                resp = CR.ChatRespError(user, ChatError.ChatErrorInvalidJSON(json.encodeToString(resp["chatError"]))),
-                corr = data["corr"]?.toString()
-              )
+              return APIResponse(CR.ChatRespError(user, ChatError.ChatErrorInvalidJSON(json.encodeToString(resp["chatError"]))), remoteHostId, corr)
             }
           } catch (e: Exception) {
             Log.e(TAG, "Error while parsing chat(s): " + e.stackTraceToString())
           }
-          APIResponse(
-            resp = CR.Response(type, json.encodeToString(data)),
-            corr = data["corr"]?.toString()
-          )
+          APIResponse(CR.Response(type, json.encodeToString(data)), remoteHostId, corr)
         } catch(e: Exception) {
-          APIResponse(CR.Invalid(str))
+          APIResponse(CR.Invalid(str), remoteHostId = null)
         }
       }
     }
@@ -3484,17 +3545,17 @@ sealed class CR {
   @Serializable @SerialName("newContactConnection") class NewContactConnection(val user: UserRef, val connection: PendingContactConnection): CR()
   @Serializable @SerialName("contactConnectionDeleted") class ContactConnectionDeleted(val user: UserRef, val connection: PendingContactConnection): CR()
   // remote events (desktop)
-  @Serializable @SerialName("remoteHostCreated") class RemoteHostCreated(val remoteHostId: Long, val oobData: RemoteCtrlOOB): CR()
+  @Serializable @SerialName("remoteHostCreated") class RemoteHostCreated(val remoteHost: RemoteHostInfo): CR()
   @Serializable @SerialName("remoteHostList") class RemoteHostList(val remoteHosts: List<RemoteHostInfo>): CR()
-  @Serializable @SerialName("remoteHostConnected") class RemoteHostConnected(val remoteHostId: Long): CR()
+  @Serializable @SerialName("remoteHostConnected") class RemoteHostConnected(val remoteHost: RemoteHostInfo): CR()
   @Serializable @SerialName("remoteHostStopped") class RemoteHostStopped(val remoteHostId: Long): CR()
   // remote events (mobile)
   @Serializable @SerialName("remoteCtrlList") class RemoteCtrlList(val remoteCtrls: List<RemoteCtrlInfo>): CR()
-  @Serializable @SerialName("remoteCtrlRegistered") class RemoteCtrlRegistered(val remoteCtrlId: Long): CR()
+  @Serializable @SerialName("remoteCtrlRegistered") class RemoteCtrlRegistered(val remoteCtrl: RemoteCtrlInfo): CR()
   @Serializable @SerialName("remoteCtrlAnnounce") class RemoteCtrlAnnounce(val fingerprint: String): CR()
-  @Serializable @SerialName("remoteCtrlFound") class RemoteCtrlFound(val remoteCtrl: RemoteCtrl): CR()
-  @Serializable @SerialName("remoteCtrlConnecting") class RemoteCtrlConnecting(val remoteCtrlId: Long, val displayName: String): CR()
-  @Serializable @SerialName("remoteCtrlConnected") class RemoteCtrlConnected(val remoteCtrlId: Long, val displayName: String): CR()
+  @Serializable @SerialName("remoteCtrlFound") class RemoteCtrlFound(val remoteCtrl: RemoteCtrlInfo): CR()
+  @Serializable @SerialName("remoteCtrlConnecting") class RemoteCtrlConnecting(val remoteCtrl: RemoteCtrlInfo): CR()
+  @Serializable @SerialName("remoteCtrlConnected") class RemoteCtrlConnected(val remoteCtrl: RemoteCtrlInfo): CR()
   @Serializable @SerialName("remoteCtrlStopped") class RemoteCtrlStopped(): CR()
   @Serializable @SerialName("versionInfo") class VersionInfo(val versionInfo: CoreVersionInfo, val chatMigrations: List<UpMigration>, val agentMigrations: List<UpMigration>): CR()
   @Serializable @SerialName("cmdOk") class CmdOk(val user: UserRef?): CR()
@@ -3767,17 +3828,17 @@ sealed class CR {
     is CallEnded -> withUser(user, "contact: ${contact.id}")
     is NewContactConnection -> withUser(user, json.encodeToString(connection))
     is ContactConnectionDeleted -> withUser(user, json.encodeToString(connection))
-    is RemoteHostCreated -> "remote host ID: $remoteHostId\noobData ${json.encodeToString(oobData)}"
-    is RemoteHostList -> "remote hosts: ${json.encodeToString(remoteHosts)}"
-    is RemoteHostConnected -> "remote host ID: $remoteHostId"
+    is RemoteHostCreated -> json.encodeToString(remoteHost)
+    is RemoteHostList -> json.encodeToString(remoteHosts)
+    is RemoteHostConnected -> json.encodeToString(remoteHost)
     is RemoteHostStopped -> "remote host ID: $remoteHostId"
     is RemoteCtrlList -> json.encodeToString(remoteCtrls)
-    is RemoteCtrlRegistered -> "remote ctrl ID: $remoteCtrlId"
+    is RemoteCtrlRegistered -> json.encodeToString(remoteCtrl)
     is RemoteCtrlAnnounce -> "fingerprint: $fingerprint"
-    is RemoteCtrlFound -> "remote ctrl: ${json.encodeToString(remoteCtrl)}"
-    is RemoteCtrlConnecting -> "remote ctrl ID: $remoteCtrlId\nhost displayName: $displayName"
-    is RemoteCtrlConnected -> "remote ctrl ID: $remoteCtrlId\nhost displayName: $displayName"
-    is RemoteCtrlStopped -> ""
+    is RemoteCtrlFound -> json.encodeToString(remoteCtrl)
+    is RemoteCtrlConnecting -> json.encodeToString(remoteCtrl)
+    is RemoteCtrlConnected -> json.encodeToString(remoteCtrl)
+    is RemoteCtrlStopped -> noDetails()
     is VersionInfo -> "version ${json.encodeToString(versionInfo)}\n\n" +
         "chat migrations: ${json.encodeToString(chatMigrations.map { it.upName })}\n\n" +
         "agent migrations: ${json.encodeToString(agentMigrations.map { it.upName })}"
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 726fbdce8..9c25afbd5 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -70,6 +70,7 @@ import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Groups
 import Simplex.Chat.Store.Messages
 import Simplex.Chat.Store.Profiles
+import Simplex.Chat.Store.Remote
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
@@ -1900,7 +1901,7 @@ processChatCommand = \case
   StopRemoteHost rh -> closeRemoteHostSession rh >> ok_
   DeleteRemoteHost rh -> deleteRemoteHost rh >> ok_
   StartRemoteCtrl -> startRemoteCtrl (execChatCommand Nothing) >> ok_
-  RegisterRemoteCtrl oob -> CRRemoteCtrlRegistered <$> registerRemoteCtrl oob
+  RegisterRemoteCtrl oob -> CRRemoteCtrlRegistered <$> withStore' (`insertRemoteCtrl` oob)
   AcceptRemoteCtrl rc -> acceptRemoteCtrl rc >> ok_
   RejectRemoteCtrl rc -> rejectRemoteCtrl rc >> ok_
   StopRemoteCtrl -> stopRemoteCtrl >> ok_
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 2a2b7cff9..22c2649f5 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -633,14 +633,14 @@ data ChatResponse
   | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
   | CRRemoteHostCreated {remoteHost :: RemoteHostInfo}
   | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
-  | CRRemoteHostConnected {remoteHostId :: RemoteHostId} -- TODO add displayName
+  | CRRemoteHostConnected {remoteHost :: RemoteHostInfo}
   | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
-  | CRRemoteCtrlRegistered {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlRegistered {remoteCtrl :: RemoteCtrlInfo}
   | CRRemoteCtrlAnnounce {fingerprint :: C.KeyHash} -- unregistered fingerprint, needs confirmation
-  | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrl} -- registered fingerprint, may connect
-  | CRRemoteCtrlConnecting {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
-  | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
+  | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrlInfo} -- registered fingerprint, may connect
+  | CRRemoteCtrlConnecting {remoteCtrl :: RemoteCtrlInfo}
+  | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo}
   | CRRemoteCtrlStopped
   | CRSQLResult {rows :: [Text]}
   | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
@@ -693,34 +693,6 @@ logResponseToFile = \case
   CRMessageError {} -> True
   _ -> False
 
-data RemoteCtrlOOB = RemoteCtrlOOB
-  { caFingerprint :: C.KeyHash,
-    displayName :: Text
-  }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON RemoteCtrlOOB where toEncoding = J.genericToEncoding J.defaultOptions
-
-data RemoteHostInfo = RemoteHostInfo
-  { remoteHostId :: RemoteHostId,
-    storePath :: FilePath,
-    displayName :: Text,
-    remoteCtrlOOB :: RemoteCtrlOOB,
-    sessionActive :: Bool
-  }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON RemoteHostInfo where toEncoding = J.genericToEncoding J.defaultOptions
-
-data RemoteCtrlInfo = RemoteCtrlInfo
-  { remoteCtrlId :: RemoteCtrlId,
-    displayName :: Text,
-    sessionActive :: Bool
-  }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON RemoteCtrlInfo where toEncoding = J.genericToEncoding J.defaultOptions
-
 data ConnectionPlan
   = CPInvitationLink {invitationLinkPlan :: InvitationLinkPlan}
   | CPContactAddress {contactAddressPlan :: ContactAddressPlan}
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 4d031634f..256e00d6d 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -33,6 +33,7 @@ import Data.Int (Int64)
 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 (decodeUtf8, encodeUtf8)
 import qualified Network.HTTP.Types as HTTP
@@ -93,7 +94,7 @@ startRemoteHost remoteHostId = do
       M.lookup remoteHostId <$> chatReadVar remoteHostSessions >>= \case
         Nothing -> logInfo $ "Session already closed for remote host " <> tshow remoteHostId
         Just _ -> closeRemoteHostSession remoteHostId >> toView (CRRemoteHostStopped remoteHostId)
-    run RemoteHost {storePath, caKey, caCert} = do
+    run rh@RemoteHost {storePath, caKey, caCert} = do
       finished <- newTVarIO False
       let parent = (C.signatureKeyPair caKey, caCert)
       sessionCreds <- liftIO $ genCredentials (Just parent) (0, 24) "Session"
@@ -120,7 +121,9 @@ startRemoteHost remoteHostId = do
                       Nothing -> toViewRemote chatResponse
                       Just localFile -> toViewRemote CRRcvFileComplete {user = ru, chatItem = AChatItem c d i ci {file = Just localFile}}
                   _ -> toViewRemote chatResponse
-              toView CRRemoteHostConnected {remoteHostId}
+              rcName <- chatReadVar localDeviceName
+              -- TODO what sets session active?
+              toView CRRemoteHostConnected {remoteHost = remoteHostInfo rh True rcName}
 
 sendHello :: (ChatMonad m) => HTTP2Client -> m (Either HTTP2.HTTP2ClientError HTTP2.HTTP2Response)
 sendHello http = liftIO (HTTP2.sendRequestDirect http req Nothing)
@@ -155,13 +158,13 @@ cancelRemoteHostSession = \case
 
 createRemoteHost :: (ChatMonad m) => m RemoteHostInfo
 createRemoteHost = do
-  let hostDisplayName = "TODO" -- you don't have remote host name here, it will be passed from remote host
-  ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) hostDisplayName
+  let rhName = "TODO" -- you don't have remote host name here, it will be passed from remote host
+  ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) rhName
   storePath <- liftIO randomStorePath
-  remoteHostId <- withStore' $ \db -> insertRemoteHost db storePath hostDisplayName caKey caCert
-  displayName <- chatReadVar localDeviceName
-  let remoteCtrlOOB = RemoteCtrlOOB {caFingerprint = C.certificateFingerprint caCert, displayName}
-  pure RemoteHostInfo {remoteHostId, storePath, displayName, remoteCtrlOOB, sessionActive = False}
+  remoteHostId <- withStore' $ \db -> insertRemoteHost db storePath rhName caKey caCert
+  rcName <- chatReadVar localDeviceName
+  let remoteCtrlOOB = RemoteCtrlOOB {fingerprint = C.certificateFingerprint caCert, displayName = rcName}
+  pure RemoteHostInfo {remoteHostId, storePath, displayName = rhName, remoteCtrlOOB, sessionActive = False}
 
 -- | Generate a random 16-char filepath without / in it by using base64url encoding.
 randomStorePath :: IO FilePath
@@ -173,10 +176,13 @@ listRemoteHosts = do
   rcName <- chatReadVar localDeviceName
   map (rhInfo active rcName) <$> withStore' getRemoteHosts
   where
-    rhInfo active rcName RemoteHost {remoteHostId, storePath, displayName, caCert} =
-      let sessionActive = M.member remoteHostId active
-          remoteCtrlOOB = RemoteCtrlOOB {caFingerprint = C.certificateFingerprint caCert, displayName = rcName}
-       in RemoteHostInfo {remoteHostId, storePath, displayName, remoteCtrlOOB, sessionActive}
+    rhInfo active rcName rh@RemoteHost {remoteHostId} =
+      remoteHostInfo rh (M.member remoteHostId active) rcName
+
+remoteHostInfo :: RemoteHost -> Bool -> Text -> RemoteHostInfo
+remoteHostInfo RemoteHost {remoteHostId, storePath, displayName, caCert} sessionActive rcName =
+  let remoteCtrlOOB = RemoteCtrlOOB {fingerprint = C.certificateFingerprint caCert, displayName = rcName}
+   in RemoteHostInfo {remoteHostId, storePath, displayName, remoteCtrlOOB, sessionActive}
 
 deleteRemoteHost :: (ChatMonad m) => RemoteHostId -> m ()
 deleteRemoteHost remoteHostId = withRemoteHost remoteHostId $ \RemoteHost {storePath} -> do
@@ -405,13 +411,13 @@ startRemoteCtrl execChatCommand =
       accepted <- newEmptyTMVarIO
       supervisor <- async $ do
         remoteCtrlId <- atomically (readTMVar accepted)
-        withRemoteCtrl remoteCtrlId $ \RemoteCtrl {displayName, fingerprint} -> do
+        withRemoteCtrl remoteCtrlId $ \rc@RemoteCtrl {fingerprint} -> do
           source <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure
-          toView $ CRRemoteCtrlConnecting {remoteCtrlId, displayName}
+          toView $ CRRemoteCtrlConnecting $ remoteCtrlInfo rc False
           atomically $ writeTVar discovered mempty -- flush unused sources
           server <- async $ Discovery.connectRevHTTP2 source fingerprint (processControllerRequest execChatCommand)
           chatModifyVar remoteCtrlSession $ fmap $ \s -> s {hostServer = Just server}
-          toView $ CRRemoteCtrlConnected {remoteCtrlId, displayName}
+          toView $ CRRemoteCtrlConnected $ remoteCtrlInfo rc True
           _ <- waitCatch server
           chatWriteVar remoteCtrlSession Nothing
           toView CRRemoteCtrlStopped
@@ -436,7 +442,7 @@ discoverRemoteCtrls discovered = Discovery.withListener go
             withStore' (`getRemoteCtrlByFingerprint` fingerprint) >>= \case
               Nothing -> toView $ CRRemoteCtrlAnnounce fingerprint -- unknown controller, ui "register" action required
               Just found@RemoteCtrl {remoteCtrlId, accepted = storedChoice} -> case storedChoice of
-                Nothing -> toView $ CRRemoteCtrlFound found -- first-time controller, ui "accept" action required
+                Nothing -> toView $ CRRemoteCtrlFound $ remoteCtrlInfo found False -- first-time controller, ui "accept" action required
                 Just False -> pure () -- skipping a rejected item
                 Just True ->
                   chatReadVar remoteCtrlSession >>= \case
@@ -444,11 +450,6 @@ discoverRemoteCtrls discovered = Discovery.withListener go
                     Just RemoteCtrlSession {accepted} -> atomically $ void $ tryPutTMVar accepted remoteCtrlId -- previously accepted controller, connect automatically
         _nonV4 -> go sock
 
-registerRemoteCtrl :: (ChatMonad m) => RemoteCtrlOOB -> m RemoteCtrlId
-registerRemoteCtrl RemoteCtrlOOB {caFingerprint, displayName} = do
-  remoteCtrlId <- withStore' $ \db -> insertRemoteCtrl db displayName caFingerprint
-  pure remoteCtrlId
-
 listRemoteCtrls :: (ChatMonad m) => m [RemoteCtrlInfo]
 listRemoteCtrls = do
   active <-
@@ -456,9 +457,12 @@ listRemoteCtrls = do
       $>>= \RemoteCtrlSession {accepted} -> atomically $ tryReadTMVar accepted
   map (rcInfo active) <$> withStore' getRemoteCtrls
   where
-    rcInfo active RemoteCtrl {remoteCtrlId, displayName} =
-      let sessionActive = active == Just remoteCtrlId
-       in RemoteCtrlInfo {remoteCtrlId, displayName, sessionActive}
+    rcInfo active rc@RemoteCtrl {remoteCtrlId} =
+      remoteCtrlInfo rc $ active == Just remoteCtrlId
+
+remoteCtrlInfo :: RemoteCtrl -> Bool -> RemoteCtrlInfo
+remoteCtrlInfo RemoteCtrl {remoteCtrlId, displayName, fingerprint, accepted} sessionActive =
+  RemoteCtrlInfo {remoteCtrlId, displayName, fingerprint, accepted, sessionActive}
 
 acceptRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ()
 acceptRemoteCtrl remoteCtrlId = do
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index cdff2b7ac..67fe7c6ff 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -24,6 +24,25 @@ data RemoteHost = RemoteHost
   }
   deriving (Show)
 
+data RemoteCtrlOOB = RemoteCtrlOOB
+  { fingerprint :: C.KeyHash,
+    displayName :: Text
+  }
+  deriving (Show)
+
+$(J.deriveJSON J.defaultOptions ''RemoteCtrlOOB)
+
+data RemoteHostInfo = RemoteHostInfo
+  { remoteHostId :: RemoteHostId,
+    storePath :: FilePath,
+    displayName :: Text,
+    remoteCtrlOOB :: RemoteCtrlOOB,
+    sessionActive :: Bool
+  }
+  deriving (Show)
+
+$(J.deriveJSON J.defaultOptions ''RemoteHostInfo)
+
 type RemoteCtrlId = Int64
 
 data RemoteCtrl = RemoteCtrl
@@ -34,4 +53,15 @@ data RemoteCtrl = RemoteCtrl
   }
   deriving (Show)
 
-$(J.deriveJSON J.defaultOptions ''RemoteCtrl)
+$(J.deriveJSON J.defaultOptions {J.omitNothingFields = True} ''RemoteCtrl)
+
+data RemoteCtrlInfo = RemoteCtrlInfo
+  { remoteCtrlId :: RemoteCtrlId,
+    displayName :: Text,
+    fingerprint :: C.KeyHash,
+    accepted :: Maybe Bool,
+    sessionActive :: Bool
+  }
+  deriving (Show)
+
+$(J.deriveJSON J.defaultOptions {J.omitNothingFields = True} ''RemoteCtrlInfo)
diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs
index c231a535b..9189a2776 100644
--- a/src/Simplex/Chat/Store/Remote.hs
+++ b/src/Simplex/Chat/Store/Remote.hs
@@ -9,14 +9,15 @@ import Data.Text (Text)
 import Database.SQLite.Simple (Only (..))
 import qualified Database.SQLite.Simple as SQL
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
-import Simplex.Chat.Remote.Types (RemoteCtrl (..), RemoteCtrlId, RemoteHost (..), RemoteHostId)
+import Simplex.Chat.Store.Shared (insertedRowId)
+import Simplex.Chat.Remote.Types
 import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow)
 import qualified Simplex.Messaging.Crypto as C
 
 insertRemoteHost :: DB.Connection -> FilePath -> Text -> C.APrivateSignKey -> C.SignedCertificate -> IO RemoteHostId
 insertRemoteHost db storePath displayName caKey caCert = do
   DB.execute db "INSERT INTO remote_hosts (store_path, display_name, ca_key, ca_cert) VALUES (?,?,?,?)" (storePath, displayName, caKey, C.SignedObject caCert)
-  fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
+  insertedRowId db
 
 getRemoteHosts :: DB.Connection -> IO [RemoteHost]
 getRemoteHosts db =
@@ -37,10 +38,11 @@ toRemoteHost (remoteHostId, storePath, displayName, caKey, C.SignedObject caCert
 deleteRemoteHostRecord :: DB.Connection -> RemoteHostId -> IO ()
 deleteRemoteHostRecord db remoteHostId = DB.execute db "DELETE FROM remote_hosts WHERE remote_host_id = ?" (Only remoteHostId)
 
-insertRemoteCtrl :: DB.Connection -> Text -> C.KeyHash -> IO RemoteCtrlId
-insertRemoteCtrl db displayName fingerprint = do
+insertRemoteCtrl :: DB.Connection -> RemoteCtrlOOB -> IO RemoteCtrlInfo
+insertRemoteCtrl db RemoteCtrlOOB {fingerprint, displayName} = do
   DB.execute db "INSERT INTO remote_controllers (display_name, fingerprint) VALUES (?,?)" (displayName, fingerprint)
-  fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
+  remoteCtrlId <- insertedRowId db
+  pure RemoteCtrlInfo {remoteCtrlId, displayName, fingerprint, accepted = Nothing, sessionActive = False}
 
 getRemoteCtrls :: DB.Connection -> IO [RemoteCtrl]
 getRemoteCtrls db =
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index d6826c877..51dcd0c6b 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -264,14 +264,14 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei
   CRNtfMessages {} -> []
   CRRemoteHostCreated RemoteHostInfo {remoteHostId, remoteCtrlOOB} -> ("remote host " <> sShow remoteHostId <> " created") : viewRemoteCtrlOOBData remoteCtrlOOB
   CRRemoteHostList hs -> viewRemoteHosts hs
-  CRRemoteHostConnected rhId -> ["remote host " <> sShow rhId <> " connected"]
+  CRRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} -> ["remote host " <> sShow rhId <> " connected"]
   CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
   CRRemoteCtrlList cs -> viewRemoteCtrls cs
-  CRRemoteCtrlRegistered rcId -> ["remote controller " <> sShow rcId <> " registered"]
+  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 rcId rcName -> ["remote controller " <> sShow rcId <> " connecting to " <> plain rcName]
-  CRRemoteCtrlConnected rcId rcName -> ["remote controller " <> sShow rcId <> " connected, " <> plain rcName]
+  CRRemoteCtrlConnecting RemoteCtrlInfo {remoteCtrlId = rcId, displayName = rcName} -> ["remote controller " <> sShow rcId <> " connecting to " <> plain rcName]
+  CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, displayName = rcName} -> ["remote controller " <> sShow rcId <> " connected, " <> plain rcName]
   CRRemoteCtrlStopped -> ["remote controller stopped"]
   CRSQLResult rows -> map plain rows
   CRSlowSQLQueries {chatQueries, agentQueries} ->
@@ -1633,8 +1633,8 @@ viewVersionInfo logLevel CoreVersionInfo {version, simplexmqVersion, simplexmqCo
     parens s = " (" <> s <> ")"
 
 viewRemoteCtrlOOBData :: RemoteCtrlOOB -> [StyledString]
-viewRemoteCtrlOOBData RemoteCtrlOOB {caFingerprint} =
-  ["connection code:", plain $ strEncode caFingerprint]
+viewRemoteCtrlOOBData RemoteCtrlOOB {fingerprint} =
+  ["connection code:", plain $ strEncode fingerprint]
 
 viewRemoteHosts :: [RemoteHostInfo] -> [StyledString]
 viewRemoteHosts = \case
@@ -1653,8 +1653,8 @@ viewRemoteCtrls = \case
       plain $ tshow remoteCtrlId <> ". " <> displayName <> if sessionActive then " (active)" else ""
 
 -- TODO fingerprint, accepted?
-viewRemoteCtrl :: RemoteCtrl -> StyledString
-viewRemoteCtrl RemoteCtrl {remoteCtrlId, displayName} =
+viewRemoteCtrl :: RemoteCtrlInfo -> StyledString
+viewRemoteCtrl RemoteCtrlInfo {remoteCtrlId, displayName} =
   plain $ tshow remoteCtrlId <> ". " <> displayName
 
 viewChatError :: ChatLogLevel -> ChatError -> [StyledString]

From fc1bba8817c93c51c03fa0d905ec87f5cf3bbbb2 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 15 Oct 2023 14:17:36 +0100
Subject: [PATCH 19/69] remote: refactor (WIP) (#3222)

* remote: refactor (WIP)

* refactor discoverRemoteCtrls

* refactor processRemoteCommand, storeRemoteFile

* refactor fetchRemoteFile

* refactor startRemoteHost, receiving files

* refactor relayCommand
---
 apps/ios/SimpleXChat/APITypes.swift           |   1 -
 .../chat/simplex/common/model/SimpleXAPI.kt   |   2 -
 src/Simplex/Chat.hs                           |   5 +-
 src/Simplex/Chat/Controller.hs                |  15 +-
 src/Simplex/Chat/Remote.hs                    | 479 +++++++++---------
 src/Simplex/Chat/Remote/Discovery.hs          |   6 +-
 src/Simplex/Chat/Store/Remote.hs              |  13 +-
 src/Simplex/Chat/Store/Shared.hs              |   3 +
 tests/RemoteTests.hs                          |   4 +-
 9 files changed, 274 insertions(+), 254 deletions(-)

diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift
index 756ab3034..761c1daf7 100644
--- a/apps/ios/SimpleXChat/APITypes.swift
+++ b/apps/ios/SimpleXChat/APITypes.swift
@@ -1804,7 +1804,6 @@ public enum ArchiveError: Decodable {
 }
 
 public enum RemoteCtrlError: Decodable {
-  case missing(remoteCtrlId: Int64)
   case inactive
   case busy
   case timeout
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
index f128fcb75..1f5cc09d4 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
@@ -4521,7 +4521,6 @@ sealed class RemoteHostError {
 @Serializable
 sealed class RemoteCtrlError {
   val string: String get() = when (this) {
-    is Missing -> "missing"
     is Inactive -> "inactive"
     is Busy -> "busy"
     is Timeout -> "timeout"
@@ -4531,7 +4530,6 @@ sealed class RemoteCtrlError {
     is CertificateUntrusted -> "certificateUntrusted"
     is BadFingerprint -> "badFingerprint"
   }
-  @Serializable @SerialName("missing") class Missing(val remoteCtrlId: Long): RemoteCtrlError()
   @Serializable @SerialName("inactive") object Inactive: RemoteCtrlError()
   @Serializable @SerialName("busy") object Busy: RemoteCtrlError()
   @Serializable @SerialName("timeout") object Timeout: RemoteCtrlError()
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 9c25afbd5..e1bd795b3 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -397,7 +397,7 @@ execChatCommand_ :: ChatMonad' m => Maybe User -> ChatCommand -> m ChatResponse
 execChatCommand_ u cmd = either (CRChatCmdError u) id <$> runExceptT (processChatCommand cmd)
 
 execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> (ByteString, ChatCommand) -> m ChatResponse
-execRemoteCommand u rh scmd = either (CRChatCmdError u) id <$> runExceptT (withRemoteHostSession rh $ \rhs -> processRemoteCommand rhs scmd)
+execRemoteCommand u rhId scmd = either (CRChatCmdError u) id <$> runExceptT (getRemoteHostSession rhId >>= (`processRemoteCommand` scmd))
 
 parseChatCommand :: ByteString -> Either String ChatCommand
 parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace
@@ -5154,9 +5154,6 @@ closeFileHandle fileId files = do
   h_ <- atomically . stateTVar fs $ \m -> (M.lookup fileId m, M.delete fileId m)
   liftIO $ mapM_ hClose h_ `catchAll_` pure ()
 
-throwChatError :: ChatMonad m => ChatErrorType -> m a
-throwChatError = throwError . ChatError
-
 deleteMembersConnections :: ChatMonad m => User -> [GroupMember] -> m ()
 deleteMembersConnections user members = do
   let memberConns =
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 22c2649f5..78848cca2 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -1158,8 +1158,7 @@ instance ToJSON RemoteHostError where
 
 -- TODO review errors, some of it can be covered by HTTP2 errors
 data RemoteCtrlError
-  = RCEMissing {remoteCtrlId :: RemoteCtrlId} -- ^ No remote session matches this identifier
-  | RCEInactive -- ^ No session is running
+  = RCEInactive -- ^ No session is running
   | RCEBusy -- ^ A session is already running
   | RCETimeout -- ^ Remote operation timed out
   | RCEDisconnected {remoteCtrlId :: RemoteCtrlId, reason :: Text} -- ^ A session disconnected by a controller
@@ -1167,6 +1166,9 @@ data RemoteCtrlError
   | RCECertificateExpired {remoteCtrlId :: RemoteCtrlId} -- ^ A connection or CA certificate in a chain have bad validity period
   | RCECertificateUntrusted {remoteCtrlId :: RemoteCtrlId} -- ^ TLS is unable to validate certificate chain presented for a connection
   | RCEBadFingerprint -- ^ Bad fingerprint data provided in OOB
+  | RCEHTTP2Error {http2Error :: String}
+  | RCEHTTP2RespStatus {statusCode :: Maybe Int} -- TODO remove
+  | RCEInvalidResponse {responseError :: String}
   deriving (Show, Exception, Generic)
 
 instance FromJSON RemoteCtrlError where
@@ -1199,7 +1201,7 @@ data RemoteHostSession
       }
 
 data RemoteCtrlSession = RemoteCtrlSession
-  { -- | Server side of transport to process remote commands and forward notifications
+  { -- | Host (mobile) side of transport to process remote commands and forward notifications
     discoverer :: Async (),
     supervisor :: Async (),
     hostServer :: Maybe (Async ()),
@@ -1239,6 +1241,10 @@ chatFinally :: ChatMonad m => m a -> m b -> m a
 chatFinally = allFinally mkChatError
 {-# INLINE chatFinally #-}
 
+onChatError :: ChatMonad m => m a -> m b -> m a
+a `onChatError` onErr = a `catchChatError` \e -> onErr >> throwError e
+{-# INLINE onChatError #-}
+
 mkChatError :: SomeException -> ChatError
 mkChatError = ChatError . CEException . show
 {-# INLINE mkChatError #-}
@@ -1246,6 +1252,9 @@ mkChatError = ChatError . CEException . show
 chatCmdError :: Maybe User -> String -> ChatResponse
 chatCmdError user = CRChatCmdError user . ChatError . CECommandError
 
+throwChatError :: ChatMonad m => ChatErrorType -> m a
+throwChatError = throwError . ChatError
+
 -- | Emit local events.
 toView :: ChatMonad' m => ChatResponse -> m ()
 toView event = do
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 256e00d6d..336b5d2cf 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -38,8 +38,8 @@ import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import qualified Network.HTTP.Types as HTTP
 import qualified Network.HTTP.Types.Status as Status
-import qualified Network.HTTP2.Client as HTTP2Client
-import qualified Network.HTTP2.Server as HTTP2Server
+import qualified Network.HTTP2.Client as HC
+import qualified Network.HTTP2.Server as HS
 import Network.Socket (SockAddr (..), hostAddressToTuple)
 import Simplex.Chat.Controller
 import Simplex.Chat.Messages (AChatItem (..), CIFile (..), CIFileStatus (..), ChatItem (..), chatNameStr)
@@ -60,103 +60,100 @@ import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), defaultHTTP2BufferSize)
-import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError, HTTP2Response (..))
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HTTP2
 import qualified Simplex.Messaging.Transport.HTTP2.Server as HTTP2
-import Simplex.Messaging.Util (bshow, ifM, tshow, ($>>=))
+import Simplex.Messaging.Util (bshow, ifM, liftEitherError, liftEitherWith, tshow, ($>>=))
 import System.FilePath (isPathSeparator, takeFileName, (</>))
 import UnliftIO
 import UnliftIO.Directory (createDirectoryIfMissing, getFileSize)
 
-withRemoteHostSession :: (ChatMonad m) => RemoteHostId -> (RemoteHostSession -> m a) -> m a
-withRemoteHostSession remoteHostId action = do
-  chatReadVar remoteHostSessions >>= maybe err action . M.lookup remoteHostId
+getRemoteHostSession :: ChatMonad m => RemoteHostId -> m RemoteHostSession
+getRemoteHostSession rhId = chatReadVar remoteHostSessions >>= maybe err pure . M.lookup rhId
   where
-    err = throwError $ ChatErrorRemoteHost remoteHostId RHMissing
+    err = throwError $ ChatErrorRemoteHost rhId RHMissing
 
-withRemoteHost :: (ChatMonad m) => RemoteHostId -> (RemoteHost -> m a) -> m a
-withRemoteHost remoteHostId action =
-  withStore' (`getRemoteHost` remoteHostId) >>= \case
-    Nothing -> throwError $ ChatErrorRemoteHost remoteHostId RHMissing
-    Just rh -> action rh
+checkNoRemoteHostSession :: ChatMonad m => RemoteHostId -> m ()
+checkNoRemoteHostSession rhId = chatReadVar remoteHostSessions >>= maybe (pure ()) err . M.lookup rhId
+  where
+    err _ = throwError $ ChatErrorRemoteHost rhId RHBusy
 
-startRemoteHost :: (ChatMonad m) => RemoteHostId -> m ()
-startRemoteHost remoteHostId = do
-  asks remoteHostSessions >>= atomically . TM.lookup remoteHostId >>= \case
-    Just _ -> throwError $ ChatErrorRemoteHost remoteHostId RHBusy
-    Nothing -> withRemoteHost remoteHostId $ \rh -> do
-      announcer <- async $ run rh
-      chatModifyVar remoteHostSessions $ M.insert remoteHostId RemoteHostSessionStarting {announcer}
+startRemoteHost :: ChatMonad m => RemoteHostId -> m ()
+startRemoteHost rhId = do
+  checkNoRemoteHostSession rhId
+  rh <- withStore (`getRemoteHost` rhId)
+  announcer <- async $ do
+    finished <- newTVarIO False
+    http <- start rh finished `onChatError` cleanup finished
+    run rh finished http
+  chatModifyVar remoteHostSessions $ M.insert rhId RemoteHostSessionStarting {announcer}
   where
     cleanup finished = do
       logInfo "Remote host http2 client fininshed"
       atomically $ writeTVar finished True
-      M.lookup remoteHostId <$> chatReadVar remoteHostSessions >>= \case
-        Nothing -> logInfo $ "Session already closed for remote host " <> tshow remoteHostId
-        Just _ -> closeRemoteHostSession remoteHostId >> toView (CRRemoteHostStopped remoteHostId)
-    run rh@RemoteHost {storePath, caKey, caCert} = do
-      finished <- newTVarIO False
+      -- TODO why this is not an error?
+      M.lookup rhId <$> chatReadVar remoteHostSessions >>= \case
+        Nothing -> logInfo $ "Session already closed for remote host " <> tshow rhId
+        Just _ -> closeRemoteHostSession rhId >> toView (CRRemoteHostStopped rhId)
+    start rh@RemoteHost {storePath, caKey, caCert} finished = do
       let parent = (C.signatureKeyPair caKey, caCert)
       sessionCreds <- liftIO $ genCredentials (Just parent) (0, 24) "Session"
       let (fingerprint, credentials) = tlsCredentials $ sessionCreds :| [parent]
-      Discovery.announceRevHTTP2 (cleanup finished) fingerprint credentials >>= \case
-        Left h2ce -> do
-          logError $ "Failed to set up remote host connection: " <> tshow h2ce
-          cleanup finished
-        Right ctrlClient -> do
-          chatModifyVar remoteHostSessions $ M.insert remoteHostId RemoteHostSessionStarted {storePath, ctrlClient}
-          chatWriteVar currentRemoteHost $ Just remoteHostId
-          sendHello ctrlClient >>= \case
-            Left h2ce -> do
-              logError $ "Failed to send initial remote host request: " <> tshow h2ce
-              cleanup finished
-            Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
-              logDebug $ "Got initial from remote host: " <> tshow bodyHead
-              oq <- asks outputQ
-              let toViewRemote = atomically . writeTBQueue oq . (Nothing,Just remoteHostId,)
-              void . async $ pollRemote finished ctrlClient "/recv" $ \chatResponse -> do
-                case chatResponse of
-                  CRRcvFileComplete {user = ru, chatItem = AChatItem c d@SMDRcv i ci@ChatItem {file = Just ciFile}} -> do
-                    handleRcvFileComplete ctrlClient storePath ru ciFile >>= \case
-                      Nothing -> toViewRemote chatResponse
-                      Just localFile -> toViewRemote CRRcvFileComplete {user = ru, chatItem = AChatItem c d i ci {file = Just localFile}}
-                  _ -> toViewRemote chatResponse
-              rcName <- chatReadVar localDeviceName
-              -- TODO what sets session active?
-              toView CRRemoteHostConnected {remoteHost = remoteHostInfo rh True rcName}
+      u <- askUnliftIO
+      ctrlClient <- liftHTTP2 $ Discovery.announceRevHTTP2 fingerprint credentials $ unliftIO u (cleanup finished) -- >>= \case
+      chatModifyVar remoteHostSessions $ M.insert rhId RemoteHostSessionStarted {storePath, ctrlClient}
+      chatWriteVar currentRemoteHost $ Just rhId
+      HTTP2Response {respBody = HTTP2Body {bodyHead}} <- sendHello ctrlClient
+      rcName <- chatReadVar localDeviceName
+      -- TODO what sets session active?
+      toView CRRemoteHostConnected {remoteHost = remoteHostInfo rh True rcName}
+      pure ctrlClient
+    run RemoteHost {storePath} finished ctrlClient = do
+      oq <- asks outputQ
+      let toViewRemote = atomically . writeTBQueue oq . (Nothing,Just rhId,)
+      -- TODO remove REST
+      void . async $ pollRemote finished ctrlClient "/recv" $ handleFile >=> toViewRemote
+      where
+        -- TODO move to view / terminal
+        handleFile = \case
+          cr@CRRcvFileComplete {user, chatItem = AChatItem c SMDRcv i ci@ChatItem {file = Just ciFile@CIFile {fileStatus = CIFSRcvComplete}}} -> do
+            maybe cr update <$> handleRcvFileComplete ctrlClient storePath user ciFile
+            where
+              update localFile = cr {chatItem = AChatItem c SMDRcv i ci {file = Just localFile}}
+          cr -> pure cr
 
-sendHello :: (ChatMonad m) => HTTP2Client -> m (Either HTTP2.HTTP2ClientError HTTP2.HTTP2Response)
-sendHello http = liftIO (HTTP2.sendRequestDirect http req Nothing)
+sendHello :: ChatMonad m => HTTP2Client -> m HTTP2Response
+sendHello http = liftHTTP2 $ HTTP2.sendRequestDirect http req Nothing
   where
-    req = HTTP2Client.requestNoBody "GET" "/" mempty
+    req = HC.requestNoBody "GET" "/" mempty
 
-pollRemote :: (ChatMonad m, J.FromJSON a) => TVar Bool -> HTTP2Client -> ByteString -> (a -> m ()) -> m ()
-pollRemote finished http path action = loop
+-- TODO how (on what condition) it would stop polling?
+-- TODO add JSON translation
+pollRemote :: ChatMonad m => TVar Bool -> HTTP2Client -> ByteString -> (ChatResponse -> m ()) -> m ()
+pollRemote finished http path action = loop `catchChatError` \e -> action (CRChatError Nothing e) >> loop
   where
     loop = do
-      liftIO (HTTP2.sendRequestDirect http req Nothing) >>= \case
-        Left e -> logError $ "pollRemote: " <> tshow (path, e)
-        Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
-          logDebug $ "Got /recv response: " <> decodeUtf8 bodyHead
-          case J.eitherDecodeStrict' bodyHead of
-            Left e -> logError $ "pollRemote/decode: " <> tshow (path, e)
-            Right o -> action o
+      -- TODO this will never load full body
+      HTTP2Response {respBody = HTTP2Body {bodyHead}} <- liftHTTP2 $ HTTP2.sendRequestDirect http req Nothing
+      json <- liftEitherWith (ChatErrorRemoteCtrl . RCEInvalidResponse) $ J.eitherDecodeStrict' bodyHead -- of
+      action json
       readTVarIO finished >>= (`unless` loop)
-    req = HTTP2Client.requestNoBody "GET" path mempty
+    req = HC.requestNoBody "GET" path mempty
 
-closeRemoteHostSession :: (ChatMonad m) => RemoteHostId -> m ()
-closeRemoteHostSession remoteHostId = withRemoteHostSession remoteHostId $ \session -> do
+closeRemoteHostSession :: ChatMonad m => RemoteHostId -> m ()
+closeRemoteHostSession remoteHostId = do
+  session <- getRemoteHostSession remoteHostId
   logInfo $ "Closing remote host session for " <> tshow remoteHostId
   liftIO $ cancelRemoteHostSession session
   chatWriteVar currentRemoteHost Nothing
   chatModifyVar remoteHostSessions $ M.delete remoteHostId
 
-cancelRemoteHostSession :: (MonadUnliftIO m) => RemoteHostSession -> m ()
+cancelRemoteHostSession :: MonadUnliftIO m => RemoteHostSession -> m ()
 cancelRemoteHostSession = \case
   RemoteHostSessionStarting {announcer} -> cancel announcer
   RemoteHostSessionStarted {ctrlClient} -> liftIO $ HTTP2.closeHTTP2Client ctrlClient
 
-createRemoteHost :: (ChatMonad m) => m RemoteHostInfo
+createRemoteHost :: ChatMonad m => m RemoteHostInfo
 createRemoteHost = do
   let rhName = "TODO" -- you don't have remote host name here, it will be passed from remote host
   ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) rhName
@@ -170,7 +167,7 @@ createRemoteHost = do
 randomStorePath :: IO FilePath
 randomStorePath = B.unpack . B64U.encode <$> getRandomBytes 12
 
-listRemoteHosts :: (ChatMonad m) => m [RemoteHostInfo]
+listRemoteHosts :: ChatMonad m => m [RemoteHostInfo]
 listRemoteHosts = do
   active <- chatReadVar remoteHostSessions
   rcName <- chatReadVar localDeviceName
@@ -184,75 +181,72 @@ remoteHostInfo RemoteHost {remoteHostId, storePath, displayName, caCert} session
   let remoteCtrlOOB = RemoteCtrlOOB {fingerprint = C.certificateFingerprint caCert, displayName = rcName}
    in RemoteHostInfo {remoteHostId, storePath, displayName, remoteCtrlOOB, sessionActive}
 
-deleteRemoteHost :: (ChatMonad m) => RemoteHostId -> m ()
-deleteRemoteHost remoteHostId = withRemoteHost remoteHostId $ \RemoteHost {storePath} -> do
+deleteRemoteHost :: ChatMonad m => RemoteHostId -> m ()
+deleteRemoteHost rhId = do
+  RemoteHost {storePath} <- withStore (`getRemoteHost` rhId)
   chatReadVar filesFolder >>= \case
     Just baseDir -> do
       let hostStore = baseDir </> storePath
       logError $ "TODO: remove " <> tshow hostStore
     Nothing -> logWarn "Local file store not available while deleting remote host"
-  withStore' $ \db -> deleteRemoteHostRecord db remoteHostId
+  withStore' (`deleteRemoteHostRecord` rhId)
 
-processRemoteCommand :: (ChatMonad m) => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
-processRemoteCommand RemoteHostSessionStarting {} _ = pure . CRChatError Nothing . ChatError $ CEInternalError "sending remote commands before session started"
-processRemoteCommand RemoteHostSessionStarted {ctrlClient} (s, cmd) = do
-  logDebug $ "processRemoteCommand: " <> tshow (s, cmd)
-  case cmd of
-    SendFile cn ctrlPath -> do
-      storeRemoteFile ctrlClient ctrlPath >>= \case
-        -- TODO: use Left
-        Nothing -> pure . CRChatError Nothing . ChatError $ CEInternalError "failed to store file on remote host"
-        Just hostPath -> relayCommand ctrlClient $ "/file " <> utf8String (chatNameStr cn) <> " " <> utf8String hostPath
-    SendImage cn ctrlPath -> do
-      storeRemoteFile ctrlClient ctrlPath >>= \case
-        Nothing -> pure . CRChatError Nothing . ChatError $ CEInternalError "failed to store image on remote host"
-        Just hostPath -> relayCommand ctrlClient $ "/image " <> utf8String (chatNameStr cn) <> " " <> utf8String hostPath
-    APISendMessage {composedMessage = cm@ComposedMessage {fileSource = Just CryptoFile {filePath = ctrlPath, cryptoArgs}}} -> do
-      storeRemoteFile ctrlClient ctrlPath >>= \case
-        Nothing -> pure . CRChatError Nothing . ChatError $ CEInternalError "failed to store file on remote host"
-        Just hostPath -> do
-          let cm' = cm {fileSource = Just CryptoFile {filePath = hostPath, cryptoArgs}} :: ComposedMessage
-          relayCommand ctrlClient $ B.takeWhile (/= '{') s <> B.toStrict (J.encode cm')
-    _ -> relayCommand ctrlClient s
-
-relayCommand :: (ChatMonad m) => HTTP2Client -> ByteString -> m ChatResponse
-relayCommand http s =
-  postBytestring Nothing http "/send" mempty s >>= \case
-    Left e -> err $ "relayCommand/post: " <> show e
-    Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
-      logDebug $ "Got /send response: " <> decodeUtf8 bodyHead
-      remoteChatResponse <- case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
-        Left e -> err $ "relayCommand/decodeValue: " <> show e
-        Right json -> case J.fromJSON $ toTaggedJSON json of
-          J.Error e -> err $ "relayCommand/fromJSON: " <> show e
-          J.Success cr -> pure cr
-      case remoteChatResponse of
-        -- TODO: intercept file responses and fetch files when needed
-        -- XXX: is that even possible, to have a file response to a command?
-        _ -> pure remoteChatResponse
+processRemoteCommand :: ChatMonad m => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
+processRemoteCommand RemoteHostSessionStarting {} _ = pure $ chatCmdError Nothing "remote command sent before session started"
+processRemoteCommand RemoteHostSessionStarted {ctrlClient} (s, cmd) =
+  uploadFile cmd >>= relayCommand ctrlClient
   where
-    err = pure . CRChatError Nothing . ChatError . CEInternalError
+    fileCmd cmdPfx cn hostPath = utf8String $ unwords [cmdPfx, chatNameStr cn, hostPath]
+    uploadFile = \case
+      SendFile cn ctrlPath -> fileCmd "/file" cn <$> storeRemoteFile ctrlClient ctrlPath
+      SendImage cn ctrlPath -> fileCmd "/image" cn <$> storeRemoteFile ctrlClient ctrlPath
+      -- TODO APISendMessage should only be used with host path already, and UI has to upload file first.
+      -- The problem is that we cannot have different file names in host and controller, because it simply won't be able to show files.
+      -- So we need to ask the host to store files BEFORE storing them in the app storage and use host names in the command and to store the file locally if it has to be shown,
+      -- or don't even store it if it's not image/video.
+      -- The current approach won't work.
+      -- It also does not account for local file encryption.
+      -- Also, local file encryption setting should be tracked in the controller, as otherwise host won't be able to decide what to do having received the upload command.
+      APISendMessage {composedMessage = cm@ComposedMessage {fileSource = Just CryptoFile {filePath = ctrlPath, cryptoArgs}}} -> do
+        hostPath <- storeRemoteFile ctrlClient ctrlPath
+        let cm' = cm {fileSource = Just CryptoFile {filePath = hostPath, cryptoArgs}} :: ComposedMessage
+        -- TODO we shouldn't manipulate JSON like that
+        pure $ B.takeWhile (/= '{') s <> B.toStrict (J.encode cm')
+      _ -> pure s
+
+relayCommand :: ChatMonad m => HTTP2Client -> ByteString -> m ChatResponse
+relayCommand http s = do
+  -- TODO ExceptT
+  let timeout' = Nothing
+  HTTP2Response {respBody = HTTP2Body {bodyHead}} <-
+    liftHTTP2 $ HTTP2.sendRequestDirect http req timeout'
+  -- TODO: large JSONs can overflow into buffered chunks
+  json <- liftEitherWith (ChatErrorRemoteCtrl . RCEInvalidResponse) $ J.eitherDecodeStrict' bodyHead
+  case J.fromJSON $ toTaggedJSON json of
+    J.Error e -> err $ show e
+    J.Success cr -> pure cr  
+  where
+    err = pure . CRChatError Nothing . ChatErrorRemoteCtrl . RCEInvalidResponse
     toTaggedJSON :: J.Value -> J.Value
     toTaggedJSON = id -- owsf2tagged TODO: get from RemoteHost
-    -- XXX: extract to http2 transport
-    postBytestring timeout' c path hs body = liftIO $ HTTP2.sendRequestDirect c req timeout'
-      where
-        req = HTTP2Client.requestBuilder "POST" path hs (Binary.fromByteString body)
+    req = HC.requestBuilder "POST" "/send" mempty (Binary.fromByteString s)
 
-handleRcvFileComplete :: (ChatMonad m) => HTTP2Client -> FilePath -> User -> CIFile 'MDRcv -> m (Maybe (CIFile 'MDRcv))
-handleRcvFileComplete http storePath remoteUser cif@CIFile {fileId, fileName, fileStatus} = case fileStatus of
-  CIFSRcvComplete ->
-    chatReadVar filesFolder >>= \case
-      Just baseDir -> do
-        let hostStore = baseDir </> storePath
-        createDirectoryIfMissing True hostStore
-        localPath <- uniqueCombine hostStore fileName
-        ok <- fetchRemoteFile http remoteUser fileId localPath
-        if ok
-          then pure $ Just (cif {fileName = localPath} :: CIFile 'MDRcv)
-          else Nothing <$ logError "fetchRemoteFile failed"
-      Nothing -> Nothing <$ logError "Local file store not available while fetching remote file"
-  _ -> Nothing <$ logDebug ("Ingoring invalid file notification for file (" <> tshow fileId <> ") " <> tshow fileName)
+-- TODO fileName is just metadata that does not determine the actual file location for UI, or whether it is encrypted or not
+-- fileSource is the actual file location (with information whether it is locally encrypted)
+handleRcvFileComplete :: ChatMonad m => HTTP2Client -> FilePath -> User -> CIFile 'MDRcv -> m (Maybe (CIFile 'MDRcv))
+handleRcvFileComplete http storePath remoteUser f@CIFile {fileId, fileName} =
+  chatReadVar filesFolder >>= \case
+    Just baseDir -> do
+      let hostStore = baseDir </> storePath
+      createDirectoryIfMissing True hostStore
+      -- TODO the problem here is that the name may turn out to be different and nothing will work
+      -- file processing seems to work "accidentally", not "by design"
+      localPath <- uniqueCombine hostStore fileName
+      fetchRemoteFile http remoteUser fileId localPath
+      pure $ Just (f {fileName = localPath} :: CIFile 'MDRcv)
+    -- TODO below will not work with CLI, it should store file to download folder when not specified
+    -- It should not load all files when received, instead it should only load files received with /fr commands
+    Nothing -> Nothing <$ logError "Local file store not available while fetching remote file"
 
 -- | Convert swift single-field sum encoding into tagged/discriminator-field
 owsf2tagged :: J.Value -> J.Value
@@ -288,36 +282,42 @@ owsf2tagged = fst . convert
 pattern OwsfTag :: (JK.Key, J.Value)
 pattern OwsfTag = (SingleFieldJSONTag, J.Bool True)
 
-storeRemoteFile :: (MonadUnliftIO m) => HTTP2Client -> FilePath -> m (Maybe FilePath)
+storeRemoteFile :: ChatMonad m => HTTP2Client -> FilePath -> m FilePath
 storeRemoteFile http localFile = do
-  putFile Nothing http uri mempty localFile >>= \case
-    Left h2ce -> Nothing <$ logError (tshow h2ce)
-    Right HTTP2.HTTP2Response {response, respBody = HTTP2Body {bodyHead}} ->
-      case HTTP.statusCode <$> HTTP2Client.responseStatus response of
-        Just 200 -> pure . Just $ B.unpack bodyHead
-        notOk -> Nothing <$ logError ("Bad response status: " <> tshow notOk)
+  fileSize <- liftIO $ fromIntegral <$> getFileSize localFile
+  -- TODO configure timeout
+  let timeout' = Nothing
+  r@HTTP2Response {respBody = HTTP2Body {bodyHead}} <-
+    liftHTTP2 $ HTTP2.sendRequestDirect http (req fileSize) timeout'
+  responseStatusOK r
+  -- TODO what if response doesn't fit in the head?
+  -- it'll be solved when processing moved to POST with Command/Response types
+  pure $ B.unpack bodyHead
   where
+    -- TODO local file encryption?
     uri = "/store?" <> HTTP.renderSimpleQuery False [("file_name", utf8String $ takeFileName localFile)]
-    putFile timeout' c path hs file = liftIO $ do
-      fileSize <- fromIntegral <$> getFileSize file
-      HTTP2.sendRequestDirect c (req fileSize) timeout'
-      where
-        req size = HTTP2Client.requestFile "PUT" path hs (HTTP2Client.FileSpec file 0 size)
+    req size = HC.requestFile "PUT" uri mempty (HC.FileSpec localFile 0 size)
 
-fetchRemoteFile :: (MonadUnliftIO m) => HTTP2Client -> User -> Int64 -> FilePath -> m Bool
+liftHTTP2 :: ChatMonad m => IO (Either HTTP2ClientError a) -> m a
+liftHTTP2 = liftEitherError $ ChatErrorRemoteCtrl . RCEHTTP2Error . show
+
+responseStatusOK :: ChatMonad m => HTTP2Response -> m ()
+responseStatusOK HTTP2Response {response} = do
+  let s = HC.responseStatus response
+  unless (s == Just Status.ok200) $
+    throwError $ ChatErrorRemoteCtrl $ RCEHTTP2RespStatus $ Status.statusCode <$> s
+
+fetchRemoteFile :: ChatMonad m => HTTP2Client -> User -> Int64 -> FilePath -> m ()
 fetchRemoteFile http User {userId = remoteUserId} remoteFileId localPath = do
-  liftIO (HTTP2.sendRequestDirect http req Nothing) >>= \case
-    Left h2ce -> False <$ logError (tshow h2ce)
-    Right HTTP2.HTTP2Response {response, respBody} ->
-      if HTTP2Client.responseStatus response == Just Status.ok200
-        then True <$ writeBodyToFile localPath respBody
-        else False <$ (logError $ "Request failed: " <> maybe "(??)" tshow (HTTP2Client.responseStatus response) <> " " <> decodeUtf8 (bodyHead respBody))
+  r@HTTP2Response {respBody} <- liftHTTP2 $ HTTP2.sendRequestDirect http req Nothing
+  responseStatusOK r
+  writeBodyToFile localPath respBody
   where
-    req = HTTP2Client.requestNoBody "GET" path mempty
+    req = HC.requestNoBody "GET" path mempty
     path = "/fetch?" <> HTTP.renderSimpleQuery False [("user_id", bshow remoteUserId), ("file_id", bshow remoteFileId)]
 
 -- XXX: extract to Transport.HTTP2 ?
-writeBodyToFile :: (MonadUnliftIO m) => FilePath -> HTTP2Body -> m ()
+writeBodyToFile :: MonadUnliftIO m => FilePath -> HTTP2Body -> m ()
 writeBodyToFile path HTTP2Body {bodyHead, bodySize, bodyPart} = do
   logInfo $ "Receiving " <> tshow bodySize <> " bytes to " <> tshow path
   liftIO . withFile path WriteMode $ \h -> do
@@ -331,7 +331,8 @@ hPutBodyChunks h getChunk = do
     hPut h chunk
     hPutBodyChunks h getChunk
 
-processControllerRequest :: forall m. (ChatMonad m) => (ByteString -> m ChatResponse) -> HTTP2.HTTP2Request -> m ()
+-- TODO command/response pattern, remove REST conventions
+processControllerRequest :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> HTTP2.HTTP2Request -> m ()
 processControllerRequest execChatCommand HTTP2.HTTP2Request {request, reqBody, sendResponse} = do
   logDebug $ "Remote controller request: " <> tshow (method <> " " <> path)
   res <- tryChatError $ case (method, ps) of
@@ -345,8 +346,8 @@ processControllerRequest execChatCommand HTTP2.HTTP2Request {request, reqBody, s
     Left e -> logError $ "Error handling remote controller request: (" <> tshow (method <> " " <> path) <> "): " <> tshow e
     Right () -> logDebug $ "Remote controller request: " <> tshow (method <> " " <> path) <> " OK"
   where
-    method = fromMaybe "" $ HTTP2Server.requestMethod request
-    path = fromMaybe "/" $ HTTP2Server.requestPath request
+    method = fromMaybe "" $ HS.requestMethod request
+    path = fromMaybe "/" $ HS.requestPath request
     (ps, query) = HTTP.decodePath path
     getHello = respond "OK"
     sendCommand = execChatCommand (bodyHead reqBody) >>= respondJSON
@@ -354,6 +355,7 @@ processControllerRequest execChatCommand HTTP2.HTTP2Request {request, reqBody, s
       chatReadVar remoteCtrlSession >>= \case
         Nothing -> respondWith Status.internalServerError500 "session not active"
         Just rcs -> atomically (readTBQueue $ remoteOutputQ rcs) >>= respondJSON
+    -- TODO liftEither storeFileQuery
     storeFile = case storeFileQuery of
       Left err -> respondWith Status.badRequest400 (Binary.putStringUtf8 err)
       Right fileName -> do
@@ -365,6 +367,7 @@ processControllerRequest execChatCommand HTTP2.HTTP2Request {request, reqBody, s
         respond $ Binary.putStringUtf8 storeRelative
       where
         storeFileQuery = parseField "file_name" $ A.many1 (A.satisfy $ not . isPathSeparator)
+    -- TODO move to ExceptT monad, catch errors in one place, convert errors to responses
     fetchFile = case fetchFileQuery of
       Left err -> respondWith Status.badRequest400 (Binary.putStringUtf8 err)
       Right (userId, fileId) -> do
@@ -372,12 +375,13 @@ processControllerRequest execChatCommand HTTP2.HTTP2Request {request, reqBody, s
         x <- withStore' $ \db -> runExceptT $ do
           user <- getUser db userId
           getRcvFileTransfer db user fileId
+        -- TODO this error handling is very ad-hoc, there is no separation between Chat errors and responses
         case x of
           Right RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}} -> do
             baseDir <- fromMaybe "." <$> chatReadVar filesFolder
             let fullPath = baseDir </> filePath
             size <- fromInteger <$> getFileSize fullPath
-            liftIO . sendResponse . HTTP2Server.responseFile Status.ok200 mempty $ HTTP2Server.FileSpec fullPath 0 size
+            liftIO . sendResponse . HS.responseFile Status.ok200 mempty $ HS.FileSpec fullPath 0 size
           Right _ -> respondWith Status.internalServerError500 "The requested file is not complete"
           Left SEUserNotFound {} -> respondWith Status.notFound404 "User not found"
           Left SERcvFileNotFound {} -> respondWith Status.notFound404 "File not found"
@@ -395,101 +399,106 @@ processControllerRequest execChatCommand HTTP2.HTTP2Request {request, reqBody, s
     respondJSON = respond . Binary.fromLazyByteString . J.encode
 
     respond = respondWith Status.ok200
-    respondWith status = liftIO . sendResponse . HTTP2Server.responseBuilder status []
+    respondWith status = liftIO . sendResponse . HS.responseBuilder status []
 
 -- * ChatRequest handlers
 
-startRemoteCtrl :: (ChatMonad m) => (ByteString -> m ChatResponse) -> m ()
-startRemoteCtrl execChatCommand =
-  chatReadVar remoteCtrlSession >>= \case
-    Just _busy -> throwError $ ChatErrorRemoteCtrl RCEBusy
-    Nothing -> do
-      size <- asks $ tbqSize . config
-      remoteOutputQ <- newTBQueueIO size
-      discovered <- newTVarIO mempty
-      discoverer <- async $ discoverRemoteCtrls discovered
-      accepted <- newEmptyTMVarIO
-      supervisor <- async $ do
-        remoteCtrlId <- atomically (readTMVar accepted)
-        withRemoteCtrl remoteCtrlId $ \rc@RemoteCtrl {fingerprint} -> do
-          source <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure
-          toView $ CRRemoteCtrlConnecting $ remoteCtrlInfo rc False
-          atomically $ writeTVar discovered mempty -- flush unused sources
-          server <- async $ Discovery.connectRevHTTP2 source fingerprint (processControllerRequest execChatCommand)
-          chatModifyVar remoteCtrlSession $ fmap $ \s -> s {hostServer = Just server}
-          toView $ CRRemoteCtrlConnected $ remoteCtrlInfo rc True
-          _ <- waitCatch server
-          chatWriteVar remoteCtrlSession Nothing
-          toView CRRemoteCtrlStopped
-      chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted, remoteOutputQ}
-
-discoverRemoteCtrls :: (ChatMonad m) => TM.TMap C.KeyHash TransportHost -> m ()
-discoverRemoteCtrls discovered = Discovery.withListener go
+startRemoteCtrl :: ChatMonad m => (ByteString -> m ChatResponse) -> m ()
+startRemoteCtrl execChatCommand = do
+  checkNoRemoteCtrlSession
+  size <- asks $ tbqSize . config
+  remoteOutputQ <- newTBQueueIO size
+  discovered <- newTVarIO mempty
+  discoverer <- async $ discoverRemoteCtrls discovered
+  accepted <- newEmptyTMVarIO
+  supervisor <- async $ runSupervisor discovered accepted
+  chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted, remoteOutputQ}
   where
-    go sock =
+    runSupervisor discovered accepted = do
+      remoteCtrlId <- atomically (readTMVar accepted)
+      rc@RemoteCtrl {fingerprint} <- withStore (`getRemoteCtrl` remoteCtrlId)
+      source <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure
+      toView $ CRRemoteCtrlConnecting $ remoteCtrlInfo rc False
+      atomically $ writeTVar discovered mempty -- flush unused sources
+      server <- async $ Discovery.connectRevHTTP2 source fingerprint (processControllerRequest execChatCommand)
+      chatModifyVar remoteCtrlSession $ fmap $ \s -> s {hostServer = Just server}
+      toView $ CRRemoteCtrlConnected $ remoteCtrlInfo rc True
+      _ <- waitCatch server
+      chatWriteVar remoteCtrlSession Nothing
+      toView CRRemoteCtrlStopped
+
+-- TODO the problem with this code was that it wasn't clear where the recursion can happen,
+-- by splitting receiving and processing to two functions it becomes clear
+discoverRemoteCtrls :: ChatMonad m => TM.TMap C.KeyHash TransportHost -> m ()
+discoverRemoteCtrls discovered = Discovery.withListener $ receive >=> process
+  where
+    -- TODO how would it receive more than one fingerprint?
+    receive sock =
       Discovery.recvAnnounce sock >>= \case
         (SockAddrInet _sockPort sockAddr, invite) -> case strDecode invite of
-          Left _ -> go sock -- ignore malformed datagrams
-          Right fingerprint -> do
-            let addr = THIPv4 (hostAddressToTuple sockAddr)
-            ifM
-              (atomically $ TM.member fingerprint discovered)
-              (logDebug $ "Fingerprint announce already knwon: " <> tshow (addr, invite))
-              ( do
-                  logInfo $ "New fingerprint announce: " <> tshow (addr, invite)
-                  atomically $ TM.insert fingerprint addr discovered
-              )
-            withStore' (`getRemoteCtrlByFingerprint` fingerprint) >>= \case
-              Nothing -> toView $ CRRemoteCtrlAnnounce fingerprint -- unknown controller, ui "register" action required
-              Just found@RemoteCtrl {remoteCtrlId, accepted = storedChoice} -> case storedChoice of
-                Nothing -> toView $ CRRemoteCtrlFound $ remoteCtrlInfo found False -- first-time controller, ui "accept" action required
-                Just False -> pure () -- skipping a rejected item
-                Just True ->
-                  chatReadVar remoteCtrlSession >>= \case
-                    Nothing -> toView . CRChatError Nothing . ChatError $ CEInternalError "Remote host found without running a session"
-                    Just RemoteCtrlSession {accepted} -> atomically $ void $ tryPutTMVar accepted remoteCtrlId -- previously accepted controller, connect automatically
-        _nonV4 -> go sock
+          -- TODO it is probably better to report errors to view here
+          Left _ -> receive sock
+          Right fingerprint -> pure (sockAddr, fingerprint)
+        _nonV4 -> receive sock
+    process (sockAddr, fingerprint) = do
+      let addr = THIPv4 (hostAddressToTuple sockAddr)
+      ifM
+        (atomically $ TM.member fingerprint discovered)
+        (logDebug $ "Fingerprint already known: " <> tshow (addr, fingerprint))
+        ( do
+            logInfo $ "New fingerprint announced: " <> tshow (addr, fingerprint)
+            atomically $ TM.insert fingerprint addr discovered
+        )
+      -- TODO we check fingerprint for duplicate where id doesn't matter - to prevent re-insert - and don't check to prevent duplicate events,
+      -- so UI now will have to check for duplicates again
+      withStore' (`getRemoteCtrlByFingerprint` fingerprint) >>= \case
+        Nothing -> toView $ CRRemoteCtrlAnnounce fingerprint -- unknown controller, ui "register" action required
+        -- TODO Maybe Bool is very confusing - the intent is very unclear here
+        Just found@RemoteCtrl {remoteCtrlId, accepted = storedChoice} -> case storedChoice of
+          Nothing -> toView $ CRRemoteCtrlFound $ remoteCtrlInfo found False -- first-time controller, ui "accept" action required
+          Just False -> pure () -- skipping a rejected item
+          Just True ->
+            chatReadVar remoteCtrlSession >>= \case
+              Nothing -> toView . CRChatError Nothing . ChatError $ CEInternalError "Remote host found without running a session"
+              Just RemoteCtrlSession {accepted} -> atomically $ void $ tryPutTMVar accepted remoteCtrlId -- previously accepted controller, connect automatically
 
-listRemoteCtrls :: (ChatMonad m) => m [RemoteCtrlInfo]
+listRemoteCtrls :: ChatMonad m => m [RemoteCtrlInfo]
 listRemoteCtrls = do
   active <-
     chatReadVar remoteCtrlSession
       $>>= \RemoteCtrlSession {accepted} -> atomically $ tryReadTMVar accepted
   map (rcInfo active) <$> withStore' getRemoteCtrls
   where
-    rcInfo active rc@RemoteCtrl {remoteCtrlId} =
-      remoteCtrlInfo rc $ active == Just remoteCtrlId
+    rcInfo activeRcId rc@RemoteCtrl {remoteCtrlId} =
+      remoteCtrlInfo rc $ activeRcId == Just remoteCtrlId
 
 remoteCtrlInfo :: RemoteCtrl -> Bool -> RemoteCtrlInfo
 remoteCtrlInfo RemoteCtrl {remoteCtrlId, displayName, fingerprint, accepted} sessionActive =
   RemoteCtrlInfo {remoteCtrlId, displayName, fingerprint, accepted, sessionActive}
 
-acceptRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ()
-acceptRemoteCtrl remoteCtrlId = do
-  withStore' $ \db -> markRemoteCtrlResolution db remoteCtrlId True
-  chatReadVar remoteCtrlSession >>= \case
-    Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
-    Just RemoteCtrlSession {accepted} -> atomically . void $ tryPutTMVar accepted remoteCtrlId -- the remote host can now proceed with connection
+acceptRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
+acceptRemoteCtrl rcId = do
+  -- TODO check it exists, check the ID is the same as in session
+  RemoteCtrlSession {accepted} <- getRemoteCtrlSession
+  withStore' $ \db -> markRemoteCtrlResolution db rcId True
+  atomically . void $ tryPutTMVar accepted rcId -- the remote host can now proceed with connection
 
-rejectRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ()
-rejectRemoteCtrl remoteCtrlId = do
-  withStore' $ \db -> markRemoteCtrlResolution db remoteCtrlId False
-  chatReadVar remoteCtrlSession >>= \case
-    Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
-    Just RemoteCtrlSession {discoverer, supervisor} -> do
-      cancel discoverer
-      cancel supervisor
+rejectRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
+rejectRemoteCtrl rcId = do
+  withStore' $ \db -> markRemoteCtrlResolution db rcId False
+  RemoteCtrlSession {discoverer, supervisor} <- getRemoteCtrlSession
+  cancel discoverer
+  cancel supervisor
 
-stopRemoteCtrl :: (ChatMonad m) => m ()
-stopRemoteCtrl =
-  chatReadVar remoteCtrlSession >>= \case
-    Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
-    Just rcs -> cancelRemoteCtrlSession rcs $ chatWriteVar remoteCtrlSession Nothing
+stopRemoteCtrl :: ChatMonad m => m ()
+stopRemoteCtrl = do
+  rcs <- getRemoteCtrlSession
+  cancelRemoteCtrlSession rcs $ chatWriteVar remoteCtrlSession Nothing
 
-cancelRemoteCtrlSession_ :: (MonadUnliftIO m) => RemoteCtrlSession -> m ()
+cancelRemoteCtrlSession_ :: MonadUnliftIO m => RemoteCtrlSession -> m ()
 cancelRemoteCtrlSession_ rcs = cancelRemoteCtrlSession rcs $ pure ()
 
-cancelRemoteCtrlSession :: (MonadUnliftIO m) => RemoteCtrlSession -> m () -> m ()
+cancelRemoteCtrlSession :: MonadUnliftIO m => RemoteCtrlSession -> m () -> m ()
 cancelRemoteCtrlSession RemoteCtrlSession {discoverer, supervisor, hostServer} cleanup = do
   cancel discoverer -- may be gone by now
   case hostServer of
@@ -498,17 +507,19 @@ cancelRemoteCtrlSession RemoteCtrlSession {discoverer, supervisor, hostServer} c
       cancel supervisor -- supervisor is blocked until session progresses
       cleanup
 
-deleteRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> m ()
-deleteRemoteCtrl remoteCtrlId =
-  chatReadVar remoteCtrlSession >>= \case
-    Nothing -> withStore' $ \db -> deleteRemoteCtrlRecord db remoteCtrlId
-    Just _ -> throwError $ ChatErrorRemoteCtrl RCEBusy
+deleteRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
+deleteRemoteCtrl rcId = do
+  checkNoRemoteCtrlSession
+  -- TODO check it exists
+  withStore' (`deleteRemoteCtrlRecord` rcId)
 
-withRemoteCtrl :: (ChatMonad m) => RemoteCtrlId -> (RemoteCtrl -> m a) -> m a
-withRemoteCtrl remoteCtrlId action =
-  withStore' (`getRemoteCtrl` remoteCtrlId) >>= \case
-    Nothing -> throwError $ ChatErrorRemoteCtrl RCEMissing {remoteCtrlId}
-    Just rc -> action rc
+getRemoteCtrlSession :: ChatMonad m => m RemoteCtrlSession
+getRemoteCtrlSession =
+  chatReadVar remoteCtrlSession >>= maybe (throwError $ ChatErrorRemoteCtrl RCEInactive) pure
+
+checkNoRemoteCtrlSession :: ChatMonad m => m ()
+checkNoRemoteCtrlSession =
+  chatReadVar remoteCtrlSession >>= maybe (pure ()) (\_ -> throwError $ ChatErrorRemoteCtrl RCEBusy)
 
 utf8String :: [Char] -> ByteString
 utf8String = encodeUtf8 . T.pack
diff --git a/src/Simplex/Chat/Remote/Discovery.hs b/src/Simplex/Chat/Remote/Discovery.hs
index 40314b4cb..01c6d12c6 100644
--- a/src/Simplex/Chat/Remote/Discovery.hs
+++ b/src/Simplex/Chat/Remote/Discovery.hs
@@ -53,8 +53,8 @@ pattern BROADCAST_PORT = "5226"
 -- | Announce tls server, wait for connection and attach http2 client to it.
 --
 -- Announcer is started when TLS server is started and stopped when a connection is made.
-announceRevHTTP2 :: (StrEncoding invite, MonadUnliftIO m) => m () -> invite -> TLS.Credentials -> m (Either HTTP2ClientError HTTP2Client)
-announceRevHTTP2 finishAction invite credentials = do
+announceRevHTTP2 :: StrEncoding a => a -> TLS.Credentials -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
+announceRevHTTP2 invite credentials finishAction = do
   httpClient <- newEmptyMVar
   started <- newEmptyTMVarIO
   finished <- newEmptyMVar
@@ -77,6 +77,8 @@ runAnnouncer inviteBS = do
       UDP.send sock inviteBS
       threadDelay 1000000
 
+-- TODO what prevents second client from connecting to the same server?
+-- Do we need to start multiple TLS servers for different mobile hosts?
 startTLSServer :: (MonadUnliftIO m) => TMVar Bool -> TLS.Credentials -> (Transport.TLS -> IO ()) -> m (Async ())
 startTLSServer started credentials = async . liftIO . runTransportServer started BROADCAST_PORT serverParams defaultTransportServerConfig
   where
diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs
index 9189a2776..a4c2ef85e 100644
--- a/src/Simplex/Chat/Store/Remote.hs
+++ b/src/Simplex/Chat/Store/Remote.hs
@@ -4,14 +4,15 @@
 
 module Simplex.Chat.Store.Remote where
 
+import Control.Monad.Except
 import Data.Int (Int64)
 import Data.Text (Text)
 import Database.SQLite.Simple (Only (..))
 import qualified Database.SQLite.Simple as SQL
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
-import Simplex.Chat.Store.Shared (insertedRowId)
+import Simplex.Chat.Store.Shared
 import Simplex.Chat.Remote.Types
-import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow)
+import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Crypto as C
 
 insertRemoteHost :: DB.Connection -> FilePath -> Text -> C.APrivateSignKey -> C.SignedCertificate -> IO RemoteHostId
@@ -23,9 +24,9 @@ getRemoteHosts :: DB.Connection -> IO [RemoteHost]
 getRemoteHosts db =
   map toRemoteHost <$> DB.query_ db remoteHostQuery
 
-getRemoteHost :: DB.Connection -> RemoteHostId -> IO (Maybe RemoteHost)
+getRemoteHost :: DB.Connection -> RemoteHostId -> ExceptT StoreError IO RemoteHost
 getRemoteHost db remoteHostId =
-  maybeFirstRow toRemoteHost $
+  ExceptT . firstRow toRemoteHost (SERemoteHostNotFound remoteHostId) $
     DB.query db (remoteHostQuery <> " WHERE remote_host_id = ?") (Only remoteHostId)
 
 remoteHostQuery :: SQL.Query
@@ -48,9 +49,9 @@ getRemoteCtrls :: DB.Connection -> IO [RemoteCtrl]
 getRemoteCtrls db =
   map toRemoteCtrl <$> DB.query_ db remoteCtrlQuery
 
-getRemoteCtrl :: DB.Connection -> RemoteCtrlId -> IO (Maybe RemoteCtrl)
+getRemoteCtrl :: DB.Connection -> RemoteCtrlId -> ExceptT StoreError IO RemoteCtrl
 getRemoteCtrl db remoteCtrlId =
-  maybeFirstRow toRemoteCtrl $
+  ExceptT . firstRow toRemoteCtrl (SERemoteCtrlNotFound remoteCtrlId) $
     DB.query db (remoteCtrlQuery <> " WHERE remote_controller_id = ?") (Only remoteCtrlId)
 
 getRemoteCtrlByFingerprint :: DB.Connection -> C.KeyHash -> IO (Maybe RemoteCtrl)
diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs
index fabe5b996..5cc1e87d5 100644
--- a/src/Simplex/Chat/Store/Shared.hs
+++ b/src/Simplex/Chat/Store/Shared.hs
@@ -31,6 +31,7 @@ import Database.SQLite.Simple.QQ (sql)
 import GHC.Generics (Generic)
 import Simplex.Chat.Messages
 import Simplex.Chat.Protocol
+import Simplex.Chat.Remote.Types
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, UserId)
@@ -100,6 +101,8 @@ data StoreError
   | SEHostMemberIdNotFound {groupId :: Int64}
   | SEContactNotFoundByFileId {fileId :: FileTransferId}
   | SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId}
+  | SERemoteHostNotFound {remoteHostId :: RemoteHostId}
+  | SERemoteCtrlNotFound {remoteCtrlId :: RemoteCtrlId}
   deriving (Show, Exception, Generic)
 
 instance FromJSON StoreError where
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 5bc184580..b739c1988 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -33,7 +33,7 @@ import UnliftIO
 import UnliftIO.Directory
 
 remoteTests :: SpecWith FilePath
-remoteTests = describe "Handshake" $ do
+remoteTests = fdescribe "Handshake" $ do
   it "generates usable credentials" genCredentialsTest
   it "connects announcer with discoverer over reverse-http2" announceDiscoverHttp2Test
   it "connects desktop and mobile" remoteHandshakeTest
@@ -70,7 +70,7 @@ announceDiscoverHttp2Test _tmp = do
   controller <- async $ do
     traceM "    - Controller: starting"
     bracket
-      (Discovery.announceRevHTTP2 (putMVar finished ()) fingerprint credentials >>= either (fail . show) pure)
+      (Discovery.announceRevHTTP2 fingerprint credentials (putMVar finished ()) >>= either (fail . show) pure)
       closeHTTP2Client
       ( \http -> do
           traceM "    - Controller: got client"

From 0d1a080a6e299ea34ece5445ac6b1484c6eaf541 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Sun, 22 Oct 2023 11:42:19 +0300
Subject: [PATCH 20/69] remote protocol (#3225)

* draft remote protocol types and external api

* types (it compiles)

* add error

* move remote controller from http to remote host client protocol

* refactor (doesnt compile)

* fix compile

* Connect remote session

* WIP: wire in remote protocol

* add commands and events

* cleanup

* fix desktop shutdown

* prepare for testing remote files

* Add file IO

* update simplexmq to master

with http2 to 4.1.4

* use json transcoder

* update simplexmq

* collapse RemoteHostSession states

* fold RemoteHello back into the protocol command
move http-command-response-http wrapper to protocol

* use sendRemoteCommand with optional attachments
use streaming request/response

* ditch lazy body streaming

* fix formatting

* put body builder/processor closer together

* wrap handleRemoteCommand around sending files

* handle ChatError's too

* remove binary, use 32-bit encoding for JSON bodies

* enable tests

* refactor

* refactor request handling

* return ChatError

* Flatten remote host

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 cabal.project                        |   4 +-
 package.yaml                         |   2 +-
 scripts/nix/sha256map.nix            |   4 +-
 simplex-chat.cabal                   |  15 +-
 src/Simplex/Chat.hs                  |  12 +-
 src/Simplex/Chat/Controller.hs       |  13 +-
 src/Simplex/Chat/Remote.hs           | 515 ++++++++++-----------------
 src/Simplex/Chat/Remote/Discovery.hs |  61 +++-
 src/Simplex/Chat/Remote/Protocol.hs  | 199 +++++++++++
 src/Simplex/Chat/Remote/Types.hs     |  70 +++-
 stack.yaml                           |   2 +-
 tests/JSONTests.hs                   |   2 +-
 tests/RemoteTests.hs                 | 328 +++++++++--------
 tests/Test.hs                        |   2 +-
 tests/ViewTests.hs                   |   1 -
 15 files changed, 693 insertions(+), 537 deletions(-)
 create mode 100644 src/Simplex/Chat/Remote/Protocol.hs

diff --git a/cabal.project b/cabal.project
index 9a9a3e25d..aebe18ae9 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: 1ad69cf74f18f25713ce564e1629d2538313b9e0
+    tag: deb3fc73595ceae34902d3402d075e3a531d5221
 
 source-repository-package
     type: git
@@ -19,7 +19,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/kazu-yamamoto/http2.git
-    tag: b5a1b7200cf5bc7044af34ba325284271f6dff25
+    tag: 804fa283f067bd3fd89b8c5f8d25b3047813a517
 
 source-repository-package
     type: git
diff --git a/package.yaml b/package.yaml
index df2624ac8..23fefc7ea 100644
--- a/package.yaml
+++ b/package.yaml
@@ -19,7 +19,6 @@ dependencies:
   - attoparsec == 0.14.*
   - base >= 4.7 && < 5
   - base64-bytestring >= 1.0 && < 1.3
-  - binary >= 0.8 && < 0.9
   - bytestring == 0.11.*
   - composition == 1.0.*
   - constraints >= 0.12 && < 0.14
@@ -36,6 +35,7 @@ dependencies:
   - memory == 0.18.*
   - mtl == 2.3.*
   - network >= 3.1.2.7 && < 3.2
+  - network-transport == 0.5.6
   - network-udp >= 0.0 && < 0.1
   - optparse-applicative >= 0.15 && < 0.17
   - process == 1.6.*
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 17d650cb0..6d5e1b9e7 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,7 +1,7 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."1ad69cf74f18f25713ce564e1629d2538313b9e0" = "1kil0962pn3ksnxh7dcwcbnkidz95yl31rm4m585ps7wnh6fp0l9";
+  "https://github.com/simplex-chat/simplexmq.git"."deb3fc73595ceae34902d3402d075e3a531d5221" = "031zrk32p8ji8hlvk8aj1v99g5zpcsran8qhq36sgi34sy6864z6";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
-  "https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb";
+  "https://github.com/kazu-yamamoto/http2.git"."804fa283f067bd3fd89b8c5f8d25b3047813a517" = "1j67wp7rfybfx3ryx08z6gqmzj85j51hmzhgx47ihgmgr47sl895";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "0kiwhvml42g9anw4d2v0zd1fpc790pj9syg5x3ik4l97fnkbbwpp";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
   "https://github.com/simplex-chat/aeson.git"."aab7b5a14d6c5ea64c64dcaee418de1bb00dcc2b" = "0jz7kda8gai893vyvj96fy962ncv8dcsx71fbddyy8zrvc88jfrr";
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 512f1427c..2260f46e4 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -127,6 +127,7 @@ library
       Simplex.Chat.Protocol
       Simplex.Chat.Remote
       Simplex.Chat.Remote.Discovery
+      Simplex.Chat.Remote.Protocol
       Simplex.Chat.Remote.Types
       Simplex.Chat.Store
       Simplex.Chat.Store.Connections
@@ -160,7 +161,6 @@ library
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
-    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -177,6 +177,7 @@ library
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
+    , network-transport ==0.5.6
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -213,7 +214,6 @@ executable simplex-bot
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
-    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -230,6 +230,7 @@ executable simplex-bot
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
+    , network-transport ==0.5.6
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -267,7 +268,6 @@ executable simplex-bot-advanced
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
-    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -284,6 +284,7 @@ executable simplex-bot-advanced
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
+    , network-transport ==0.5.6
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -323,7 +324,6 @@ executable simplex-broadcast-bot
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
-    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -340,6 +340,7 @@ executable simplex-broadcast-bot
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
+    , network-transport ==0.5.6
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -378,7 +379,6 @@ executable simplex-chat
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
-    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -395,6 +395,7 @@ executable simplex-chat
     , memory ==0.18.*
     , mtl ==2.3.*
     , network ==3.1.*
+    , network-transport ==0.5.6
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -437,7 +438,6 @@ executable simplex-directory-service
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
-    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -454,6 +454,7 @@ executable simplex-directory-service
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
+    , network-transport ==0.5.6
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -519,7 +520,6 @@ test-suite simplex-chat-test
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
-    , binary ==0.8.*
     , bytestring ==0.11.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
@@ -539,6 +539,7 @@ test-suite simplex-chat-test
     , memory ==0.18.*
     , mtl ==2.3.*
     , network ==3.1.*
+    , network-transport ==0.5.6
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 87a8fd356..a491561cc 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -109,6 +109,7 @@ import System.Random (randomRIO)
 import Text.Read (readMaybe)
 import UnliftIO.Async
 import UnliftIO.Concurrent (forkFinally, forkIO, mkWeakThreadId, threadDelay)
+import qualified UnliftIO.Exception as E
 import UnliftIO.Directory
 import UnliftIO.IO (hClose, hSeek, hTell, openFile)
 import UnliftIO.STM
@@ -389,17 +390,20 @@ execChatCommand rh s = do
   case parseChatCommand s of
     Left e -> pure $ chatCmdError u e
     Right cmd -> case rh of
-      Just remoteHostId | allowRemoteCommand cmd -> execRemoteCommand u remoteHostId (s, cmd)
+      Just remoteHostId | allowRemoteCommand cmd -> execRemoteCommand u remoteHostId s
       _ -> execChatCommand_ u cmd
 
 execChatCommand' :: ChatMonad' m => ChatCommand -> m ChatResponse
 execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` cmd)
 
 execChatCommand_ :: ChatMonad' m => Maybe User -> ChatCommand -> m ChatResponse
-execChatCommand_ u cmd = either (CRChatCmdError u) id <$> runExceptT (processChatCommand cmd)
+execChatCommand_ u cmd = handleCommandError u $ processChatCommand cmd
 
-execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> (ByteString, ChatCommand) -> m ChatResponse
-execRemoteCommand u rhId scmd = either (CRChatCmdError u) id <$> runExceptT (getRemoteHostSession rhId >>= (`processRemoteCommand` scmd))
+execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> ByteString -> m ChatResponse
+execRemoteCommand u rhId s = handleCommandError u $ getRemoteHostSession rhId >>= \rh -> processRemoteCommand rhId rh s
+
+handleCommandError :: ChatMonad' m => Maybe User -> ExceptT ChatError m ChatResponse -> m ChatResponse
+handleCommandError u a = either (CRChatCmdError u) id <$> (runExceptT a `E.catch` (pure . Left . mkChatError))
 
 parseChatCommand :: ByteString -> Either String ChatCommand
 parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 276bc69c3..d2179b1a9 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -72,7 +72,6 @@ import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), Cor
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import Simplex.Messaging.Util (allFinally, catchAllErrors, liftEitherError, tryAllErrors, (<$$>))
 import Simplex.Messaging.Version
 import System.IO (Handle)
@@ -1153,6 +1152,7 @@ data RemoteHostError
   | RHTimeout -- ^ A discovery or a remote operation has timed out
   | RHDisconnected {reason :: Text} -- ^ A session disconnected by a host
   | RHConnectionLost {reason :: Text} -- ^ A session disconnected due to transport issues
+  | RHProtocolError RemoteProtocolError
   deriving (Show, Exception, Generic)
 
 instance FromJSON RemoteHostError where
@@ -1175,6 +1175,7 @@ data RemoteCtrlError
   | RCEHTTP2Error {http2Error :: String}
   | RCEHTTP2RespStatus {statusCode :: Maybe Int} -- TODO remove
   | RCEInvalidResponse {responseError :: String}
+  | RCEProtocolError {protocolError :: RemoteProtocolError}
   deriving (Show, Exception, Generic)
 
 instance FromJSON RemoteCtrlError where
@@ -1196,16 +1197,6 @@ instance ToJSON ArchiveError where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "AE"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "AE"
 
-data RemoteHostSession
-  = RemoteHostSessionStarting
-      { announcer :: Async ()
-      }
-  | RemoteHostSessionStarted
-      { -- | Path for local resources to be synchronized with host
-        storePath :: FilePath,
-        ctrlClient :: HTTP2Client
-      }
-
 data RemoteCtrlSession = RemoteCtrlSession
   { -- | Host (mobile) side of transport to process remote commands and forward notifications
     discoverer :: Async (),
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 336b5d2cf..c195b4631 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -20,148 +19,136 @@ import Control.Monad.IO.Class
 import Control.Monad.Reader (asks)
 import Control.Monad.STM (retry)
 import Crypto.Random (getRandomBytes)
-import Data.Aeson ((.=))
 import qualified Data.Aeson as J
-import qualified Data.Aeson.Key as JK
-import qualified Data.Aeson.KeyMap as JM
-import qualified Data.Attoparsec.ByteString.Char8 as A
-import qualified Data.Binary.Builder as Binary
-import Data.ByteString (ByteString, hPut)
+import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base64.URL as B64U
+import Data.ByteString.Builder (Builder)
 import qualified Data.ByteString.Char8 as B
-import Data.Int (Int64)
 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 (decodeUtf8, encodeUtf8)
-import qualified Network.HTTP.Types as HTTP
-import qualified Network.HTTP.Types.Status as Status
-import qualified Network.HTTP2.Client as HC
-import qualified Network.HTTP2.Server as HS
+import Data.Text.Encoding (encodeUtf8)
+import Data.Word (Word32)
+import Network.HTTP2.Server (responseStreaming)
+import qualified Network.HTTP.Types as N
 import Network.Socket (SockAddr (..), hostAddressToTuple)
 import Simplex.Chat.Controller
-import Simplex.Chat.Messages (AChatItem (..), CIFile (..), CIFileStatus (..), ChatItem (..), chatNameStr)
-import Simplex.Chat.Messages.CIContent (MsgDirection (..), SMsgDirection (..))
 import qualified Simplex.Chat.Remote.Discovery as Discovery
+import Simplex.Chat.Remote.Protocol
 import Simplex.Chat.Remote.Types
-import Simplex.Chat.Store.Files (getRcvFileTransfer)
-import Simplex.Chat.Store.Profiles (getUser)
 import Simplex.Chat.Store.Remote
-import Simplex.Chat.Store.Shared (StoreError (..))
-import Simplex.Chat.Types
-import Simplex.FileTransfer.Util (uniqueCombine)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
-import Simplex.Messaging.Parsers (pattern SingleFieldJSONTag, pattern TaggedObjectJSONData, pattern TaggedObjectJSONTag)
+import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
-import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), defaultHTTP2BufferSize)
-import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError, HTTP2Response (..))
-import qualified Simplex.Messaging.Transport.HTTP2.Client as HTTP2
-import qualified Simplex.Messaging.Transport.HTTP2.Server as HTTP2
-import Simplex.Messaging.Util (bshow, ifM, liftEitherError, liftEitherWith, tshow, ($>>=))
-import System.FilePath (isPathSeparator, takeFileName, (</>))
+import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
+import Simplex.Messaging.Util (ifM, liftEitherError, liftEitherWith, liftError, liftIOEither, tryAllErrors, tshow, ($>>=))
+import System.FilePath ((</>))
 import UnliftIO
-import UnliftIO.Directory (createDirectoryIfMissing, getFileSize)
+
+-- * Desktop side
 
 getRemoteHostSession :: ChatMonad m => RemoteHostId -> m RemoteHostSession
-getRemoteHostSession rhId = chatReadVar remoteHostSessions >>= maybe err pure . M.lookup rhId
-  where
-    err = throwError $ ChatErrorRemoteHost rhId RHMissing
+getRemoteHostSession rhId = withRemoteHostSession rhId $ \_ s -> pure $ Right s
 
-checkNoRemoteHostSession :: ChatMonad m => RemoteHostId -> m ()
-checkNoRemoteHostSession rhId = chatReadVar remoteHostSessions >>= maybe (pure ()) err . M.lookup rhId
+withRemoteHostSession :: ChatMonad m => RemoteHostId -> (TM.TMap RemoteHostId RemoteHostSession -> RemoteHostSession -> STM (Either ChatError a)) -> m a
+withRemoteHostSession rhId = withRemoteHostSession_ rhId missing
   where
-    err _ = throwError $ ChatErrorRemoteHost rhId RHBusy
+    missing _ = pure . Left $ ChatErrorRemoteHost rhId RHMissing
+
+withNoRemoteHostSession :: ChatMonad m => RemoteHostId -> (TM.TMap RemoteHostId RemoteHostSession -> STM (Either ChatError a)) -> m a
+withNoRemoteHostSession rhId action = withRemoteHostSession_ rhId action busy
+  where
+    busy _ _ = pure . Left $ ChatErrorRemoteHost rhId RHBusy
+
+-- | Atomically process controller state wrt. specific remote host session
+withRemoteHostSession_ :: ChatMonad m => RemoteHostId -> (TM.TMap RemoteHostId RemoteHostSession -> STM (Either ChatError a)) -> (TM.TMap RemoteHostId RemoteHostSession -> RemoteHostSession -> STM (Either ChatError a)) -> m a
+withRemoteHostSession_ rhId missing present = do
+  sessions <- asks remoteHostSessions
+  liftIOEither . atomically $ TM.lookup rhId sessions >>= maybe (missing sessions) (present sessions)
 
 startRemoteHost :: ChatMonad m => RemoteHostId -> m ()
 startRemoteHost rhId = do
-  checkNoRemoteHostSession rhId
   rh <- withStore (`getRemoteHost` rhId)
-  announcer <- async $ do
-    finished <- newTVarIO False
-    http <- start rh finished `onChatError` cleanup finished
-    run rh finished http
-  chatModifyVar remoteHostSessions $ M.insert rhId RemoteHostSessionStarting {announcer}
+  tasks <- startRemoteHostSession rh
+  logInfo $ "Remote host session starting for " <> tshow rhId
+  asyncRegistered tasks $ run rh tasks `catchAny` \err -> do
+    logError $ "Remote host session startup failed for " <> tshow rhId <> ": " <> tshow err
+    cancelTasks tasks
+    chatModifyVar remoteHostSessions $ M.delete rhId
+    throwError $ fromMaybe (mkChatError err) $ fromException err
+  -- logInfo $ "Remote host session starting for " <> tshow rhId
   where
-    cleanup finished = do
-      logInfo "Remote host http2 client fininshed"
-      atomically $ writeTVar finished True
-      -- TODO why this is not an error?
-      M.lookup rhId <$> chatReadVar remoteHostSessions >>= \case
-        Nothing -> logInfo $ "Session already closed for remote host " <> tshow rhId
-        Just _ -> closeRemoteHostSession rhId >> toView (CRRemoteHostStopped rhId)
-    start rh@RemoteHost {storePath, caKey, caCert} finished = do
-      let parent = (C.signatureKeyPair caKey, caCert)
-      sessionCreds <- liftIO $ genCredentials (Just parent) (0, 24) "Session"
-      let (fingerprint, credentials) = tlsCredentials $ sessionCreds :| [parent]
-      u <- askUnliftIO
-      ctrlClient <- liftHTTP2 $ Discovery.announceRevHTTP2 fingerprint credentials $ unliftIO u (cleanup finished) -- >>= \case
-      chatModifyVar remoteHostSessions $ M.insert rhId RemoteHostSessionStarted {storePath, ctrlClient}
-      chatWriteVar currentRemoteHost $ Just rhId
-      HTTP2Response {respBody = HTTP2Body {bodyHead}} <- sendHello ctrlClient
+    run :: ChatMonad m => RemoteHost -> Tasks -> m ()
+    run rh@RemoteHost {storePath} tasks = do
+      (fingerprint, credentials) <- liftIO $ genSessionCredentials rh
+      cleanupIO <- toIO $ do
+        logNote $ "Remote host session stopping for " <> tshow rhId
+        cancelTasks tasks -- cancel our tasks anyway
+        chatModifyVar currentRemoteHost $ \cur -> if cur == Just rhId then Nothing else cur -- only wipe the closing RH
+        withRemoteHostSession rhId $ \sessions _ -> Right <$> TM.delete rhId sessions
+        toView (CRRemoteHostStopped rhId) -- only signal "stopped" when the session is unregistered cleanly
+      -- block until some client is connected or an error happens
+      logInfo $ "Remote host session connecting for " <> tshow rhId
+      httpClient <- liftEitherError (ChatErrorRemoteCtrl . RCEHTTP2Error . show) $ Discovery.announceRevHTTP2 tasks fingerprint credentials cleanupIO
+      logInfo $ "Remote host session connected for " <> tshow rhId
       rcName <- chatReadVar localDeviceName
-      -- TODO what sets session active?
-      toView CRRemoteHostConnected {remoteHost = remoteHostInfo rh True rcName}
-      pure ctrlClient
-    run RemoteHost {storePath} finished ctrlClient = do
+      -- test connection and establish a protocol layer
+      remoteHostClient <- liftRH rhId $ createRemoteHostClient httpClient rcName
+      -- set up message polling
       oq <- asks outputQ
-      let toViewRemote = atomically . writeTBQueue oq . (Nothing,Just rhId,)
-      -- TODO remove REST
-      void . async $ pollRemote finished ctrlClient "/recv" $ handleFile >=> toViewRemote
+      asyncRegistered tasks . forever $ do
+        liftRH rhId (remoteRecv remoteHostClient 1000000) >>= mapM_ (atomically . writeTBQueue oq . (Nothing,Just rhId,))
+      -- update session state
+      logInfo $ "Remote host session started for " <> tshow rhId
+      chatModifyVar remoteHostSessions $ M.adjust (\rhs -> rhs {remoteHostClient = Just remoteHostClient}) rhId
+      chatWriteVar currentRemoteHost $ Just rhId
+      toView $ CRRemoteHostConnected RemoteHostInfo
+        { remoteHostId = rhId,
+          storePath = storePath,
+          displayName = remoteDeviceName remoteHostClient,
+          remoteCtrlOOB = RemoteCtrlOOB {fingerprint, displayName=rcName},
+          sessionActive = True
+        }
+
+    genSessionCredentials RemoteHost {caKey, caCert} = do
+      sessionCreds <- genCredentials (Just parent) (0, 24) "Session"
+      pure . tlsCredentials $ sessionCreds :| [parent]
       where
-        -- TODO move to view / terminal
-        handleFile = \case
-          cr@CRRcvFileComplete {user, chatItem = AChatItem c SMDRcv i ci@ChatItem {file = Just ciFile@CIFile {fileStatus = CIFSRcvComplete}}} -> do
-            maybe cr update <$> handleRcvFileComplete ctrlClient storePath user ciFile
-            where
-              update localFile = cr {chatItem = AChatItem c SMDRcv i ci {file = Just localFile}}
-          cr -> pure cr
+        parent = (C.signatureKeyPair caKey, caCert)
 
-sendHello :: ChatMonad m => HTTP2Client -> m HTTP2Response
-sendHello http = liftHTTP2 $ HTTP2.sendRequestDirect http req Nothing
-  where
-    req = HC.requestNoBody "GET" "/" mempty
-
--- TODO how (on what condition) it would stop polling?
--- TODO add JSON translation
-pollRemote :: ChatMonad m => TVar Bool -> HTTP2Client -> ByteString -> (ChatResponse -> m ()) -> m ()
-pollRemote finished http path action = loop `catchChatError` \e -> action (CRChatError Nothing e) >> loop
-  where
-    loop = do
-      -- TODO this will never load full body
-      HTTP2Response {respBody = HTTP2Body {bodyHead}} <- liftHTTP2 $ HTTP2.sendRequestDirect http req Nothing
-      json <- liftEitherWith (ChatErrorRemoteCtrl . RCEInvalidResponse) $ J.eitherDecodeStrict' bodyHead -- of
-      action json
-      readTVarIO finished >>= (`unless` loop)
-    req = HC.requestNoBody "GET" path mempty
+-- | Atomically check/register session and prepare its task list
+startRemoteHostSession :: ChatMonad m => RemoteHost -> m Tasks
+startRemoteHostSession RemoteHost {remoteHostId, storePath} = withNoRemoteHostSession remoteHostId $ \sessions -> do
+  remoteHostTasks <- newTVar []
+  TM.insert remoteHostId RemoteHostSession {remoteHostTasks, storePath, remoteHostClient = Nothing} sessions
+  pure $ Right remoteHostTasks
 
 closeRemoteHostSession :: ChatMonad m => RemoteHostId -> m ()
-closeRemoteHostSession remoteHostId = do
-  session <- getRemoteHostSession remoteHostId
-  logInfo $ "Closing remote host session for " <> tshow remoteHostId
-  liftIO $ cancelRemoteHostSession session
-  chatWriteVar currentRemoteHost Nothing
-  chatModifyVar remoteHostSessions $ M.delete remoteHostId
+closeRemoteHostSession rhId = do
+  logNote $ "Closing remote host session for " <> tshow rhId
+  chatModifyVar currentRemoteHost $ \cur -> if cur == Just rhId then Nothing else cur -- only wipe the closing RH
+  session <- withRemoteHostSession rhId $ \sessions rhs -> Right rhs <$ TM.delete rhId sessions
+  cancelRemoteHostSession session
 
 cancelRemoteHostSession :: MonadUnliftIO m => RemoteHostSession -> m ()
-cancelRemoteHostSession = \case
-  RemoteHostSessionStarting {announcer} -> cancel announcer
-  RemoteHostSessionStarted {ctrlClient} -> liftIO $ HTTP2.closeHTTP2Client ctrlClient
+cancelRemoteHostSession RemoteHostSession {remoteHostTasks, remoteHostClient} = do
+  cancelTasks remoteHostTasks
+  mapM_ closeRemoteHostClient remoteHostClient
 
 createRemoteHost :: ChatMonad m => m RemoteHostInfo
 createRemoteHost = do
-  let rhName = "TODO" -- you don't have remote host name here, it will be passed from remote host
-  ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) rhName
+  ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) "Host"
   storePath <- liftIO randomStorePath
-  remoteHostId <- withStore' $ \db -> insertRemoteHost db storePath rhName caKey caCert
-  rcName <- chatReadVar localDeviceName
-  let remoteCtrlOOB = RemoteCtrlOOB {fingerprint = C.certificateFingerprint caCert, displayName = rcName}
-  pure RemoteHostInfo {remoteHostId, storePath, displayName = rhName, remoteCtrlOOB, sessionActive = False}
+  let remoteName = "" -- will be passed from remote host in hello
+  remoteHostId <- withStore' $ \db -> insertRemoteHost db storePath remoteName caKey caCert
+  localName <- chatReadVar localDeviceName
+  let remoteCtrlOOB = RemoteCtrlOOB {fingerprint = C.certificateFingerprint caCert, displayName = localName}
+  pure RemoteHostInfo {remoteHostId, storePath, displayName = remoteName, remoteCtrlOOB, sessionActive = False}
 
 -- | Generate a random 16-char filepath without / in it by using base64url encoding.
 randomStorePath :: IO FilePath
@@ -191,241 +178,111 @@ deleteRemoteHost rhId = do
     Nothing -> logWarn "Local file store not available while deleting remote host"
   withStore' (`deleteRemoteHostRecord` rhId)
 
-processRemoteCommand :: ChatMonad m => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
-processRemoteCommand RemoteHostSessionStarting {} _ = pure $ chatCmdError Nothing "remote command sent before session started"
-processRemoteCommand RemoteHostSessionStarted {ctrlClient} (s, cmd) =
-  uploadFile cmd >>= relayCommand ctrlClient
-  where
-    fileCmd cmdPfx cn hostPath = utf8String $ unwords [cmdPfx, chatNameStr cn, hostPath]
-    uploadFile = \case
-      SendFile cn ctrlPath -> fileCmd "/file" cn <$> storeRemoteFile ctrlClient ctrlPath
-      SendImage cn ctrlPath -> fileCmd "/image" cn <$> storeRemoteFile ctrlClient ctrlPath
-      -- TODO APISendMessage should only be used with host path already, and UI has to upload file first.
-      -- The problem is that we cannot have different file names in host and controller, because it simply won't be able to show files.
-      -- So we need to ask the host to store files BEFORE storing them in the app storage and use host names in the command and to store the file locally if it has to be shown,
-      -- or don't even store it if it's not image/video.
-      -- The current approach won't work.
-      -- It also does not account for local file encryption.
-      -- Also, local file encryption setting should be tracked in the controller, as otherwise host won't be able to decide what to do having received the upload command.
-      APISendMessage {composedMessage = cm@ComposedMessage {fileSource = Just CryptoFile {filePath = ctrlPath, cryptoArgs}}} -> do
-        hostPath <- storeRemoteFile ctrlClient ctrlPath
-        let cm' = cm {fileSource = Just CryptoFile {filePath = hostPath, cryptoArgs}} :: ComposedMessage
-        -- TODO we shouldn't manipulate JSON like that
-        pure $ B.takeWhile (/= '{') s <> B.toStrict (J.encode cm')
-      _ -> pure s
+processRemoteCommand :: ChatMonad m => RemoteHostId -> RemoteHostSession -> ByteString -> m ChatResponse
+processRemoteCommand remoteHostId RemoteHostSession {remoteHostClient = Just rhc} s = liftRH remoteHostId $ remoteSend rhc s
+processRemoteCommand _ _ _ = pure $ chatCmdError Nothing "remote command sent before session started"
 
-relayCommand :: ChatMonad m => HTTP2Client -> ByteString -> m ChatResponse
-relayCommand http s = do
-  -- TODO ExceptT
-  let timeout' = Nothing
-  HTTP2Response {respBody = HTTP2Body {bodyHead}} <-
-    liftHTTP2 $ HTTP2.sendRequestDirect http req timeout'
-  -- TODO: large JSONs can overflow into buffered chunks
-  json <- liftEitherWith (ChatErrorRemoteCtrl . RCEInvalidResponse) $ J.eitherDecodeStrict' bodyHead
-  case J.fromJSON $ toTaggedJSON json of
-    J.Error e -> err $ show e
-    J.Success cr -> pure cr  
-  where
-    err = pure . CRChatError Nothing . ChatErrorRemoteCtrl . RCEInvalidResponse
-    toTaggedJSON :: J.Value -> J.Value
-    toTaggedJSON = id -- owsf2tagged TODO: get from RemoteHost
-    req = HC.requestBuilder "POST" "/send" mempty (Binary.fromByteString s)
+liftRH :: ChatMonad m => RemoteHostId -> ExceptT RemoteProtocolError IO a -> m a
+liftRH rhId = liftError (ChatErrorRemoteHost rhId . RHProtocolError)
 
--- TODO fileName is just metadata that does not determine the actual file location for UI, or whether it is encrypted or not
--- fileSource is the actual file location (with information whether it is locally encrypted)
-handleRcvFileComplete :: ChatMonad m => HTTP2Client -> FilePath -> User -> CIFile 'MDRcv -> m (Maybe (CIFile 'MDRcv))
-handleRcvFileComplete http storePath remoteUser f@CIFile {fileId, fileName} =
-  chatReadVar filesFolder >>= \case
-    Just baseDir -> do
-      let hostStore = baseDir </> storePath
-      createDirectoryIfMissing True hostStore
-      -- TODO the problem here is that the name may turn out to be different and nothing will work
-      -- file processing seems to work "accidentally", not "by design"
-      localPath <- uniqueCombine hostStore fileName
-      fetchRemoteFile http remoteUser fileId localPath
-      pure $ Just (f {fileName = localPath} :: CIFile 'MDRcv)
-    -- TODO below will not work with CLI, it should store file to download folder when not specified
-    -- It should not load all files when received, instead it should only load files received with /fr commands
-    Nothing -> Nothing <$ logError "Local file store not available while fetching remote file"
+-- * Mobile side
 
--- | Convert swift single-field sum encoding into tagged/discriminator-field
-owsf2tagged :: J.Value -> J.Value
-owsf2tagged = fst . convert
-  where
-    convert val = case val of
-      J.Object o
-        | JM.size o == 2 ->
-            case JM.toList o of
-              [OwsfTag, o'] -> tagged o'
-              [o', OwsfTag] -> tagged o'
-              _ -> props
-        | otherwise -> props
-        where
-          props = (J.Object $ fmap owsf2tagged o, False)
-      J.Array a -> (J.Array $ fmap owsf2tagged a, False)
-      _ -> (val, False)
-    -- `tagged` converts the pair of single-field object encoding to tagged encoding.
-    -- It sets innerTag returned by `convert` to True to prevent the tag being overwritten.
-    tagged (k, v) = (J.Object pairs, True)
-      where
-        (v', innerTag) = convert v
-        pairs = case v' of
-          -- `innerTag` indicates that internal object already has tag,
-          -- so the current tag cannot be inserted into it.
-          J.Object o
-            | innerTag -> pair
-            | otherwise -> JM.insert TaggedObjectJSONTag tag o
-          _ -> pair
-        tag = J.String $ JK.toText k
-        pair = JM.fromList [TaggedObjectJSONTag .= tag, TaggedObjectJSONData .= v']
-
-pattern OwsfTag :: (JK.Key, J.Value)
-pattern OwsfTag = (SingleFieldJSONTag, J.Bool True)
-
-storeRemoteFile :: ChatMonad m => HTTP2Client -> FilePath -> m FilePath
-storeRemoteFile http localFile = do
-  fileSize <- liftIO $ fromIntegral <$> getFileSize localFile
-  -- TODO configure timeout
-  let timeout' = Nothing
-  r@HTTP2Response {respBody = HTTP2Body {bodyHead}} <-
-    liftHTTP2 $ HTTP2.sendRequestDirect http (req fileSize) timeout'
-  responseStatusOK r
-  -- TODO what if response doesn't fit in the head?
-  -- it'll be solved when processing moved to POST with Command/Response types
-  pure $ B.unpack bodyHead
-  where
-    -- TODO local file encryption?
-    uri = "/store?" <> HTTP.renderSimpleQuery False [("file_name", utf8String $ takeFileName localFile)]
-    req size = HC.requestFile "PUT" uri mempty (HC.FileSpec localFile 0 size)
-
-liftHTTP2 :: ChatMonad m => IO (Either HTTP2ClientError a) -> m a
-liftHTTP2 = liftEitherError $ ChatErrorRemoteCtrl . RCEHTTP2Error . show
-
-responseStatusOK :: ChatMonad m => HTTP2Response -> m ()
-responseStatusOK HTTP2Response {response} = do
-  let s = HC.responseStatus response
-  unless (s == Just Status.ok200) $
-    throwError $ ChatErrorRemoteCtrl $ RCEHTTP2RespStatus $ Status.statusCode <$> s
-
-fetchRemoteFile :: ChatMonad m => HTTP2Client -> User -> Int64 -> FilePath -> m ()
-fetchRemoteFile http User {userId = remoteUserId} remoteFileId localPath = do
-  r@HTTP2Response {respBody} <- liftHTTP2 $ HTTP2.sendRequestDirect http req Nothing
-  responseStatusOK r
-  writeBodyToFile localPath respBody
-  where
-    req = HC.requestNoBody "GET" path mempty
-    path = "/fetch?" <> HTTP.renderSimpleQuery False [("user_id", bshow remoteUserId), ("file_id", bshow remoteFileId)]
-
--- XXX: extract to Transport.HTTP2 ?
-writeBodyToFile :: MonadUnliftIO m => FilePath -> HTTP2Body -> m ()
-writeBodyToFile path HTTP2Body {bodyHead, bodySize, bodyPart} = do
-  logInfo $ "Receiving " <> tshow bodySize <> " bytes to " <> tshow path
-  liftIO . withFile path WriteMode $ \h -> do
-    hPut h bodyHead
-    mapM_ (hPutBodyChunks h) bodyPart
-
-hPutBodyChunks :: Handle -> (Int -> IO ByteString) -> IO ()
-hPutBodyChunks h getChunk = do
-  chunk <- getChunk defaultHTTP2BufferSize
-  unless (B.null chunk) $ do
-    hPut h chunk
-    hPutBodyChunks h getChunk
-
--- TODO command/response pattern, remove REST conventions
-processControllerRequest :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> HTTP2.HTTP2Request -> m ()
-processControllerRequest execChatCommand HTTP2.HTTP2Request {request, reqBody, sendResponse} = do
-  logDebug $ "Remote controller request: " <> tshow (method <> " " <> path)
-  res <- tryChatError $ case (method, ps) of
-    ("GET", []) -> getHello
-    ("POST", ["send"]) -> sendCommand
-    ("GET", ["recv"]) -> recvMessage
-    ("PUT", ["store"]) -> storeFile
-    ("GET", ["fetch"]) -> fetchFile
-    unexpected -> respondWith Status.badRequest400 $ "unexpected method/path: " <> Binary.putStringUtf8 (show unexpected)
-  case res of
-    Left e -> logError $ "Error handling remote controller request: (" <> tshow (method <> " " <> path) <> "): " <> tshow e
-    Right () -> logDebug $ "Remote controller request: " <> tshow (method <> " " <> path) <> " OK"
-  where
-    method = fromMaybe "" $ HS.requestMethod request
-    path = fromMaybe "/" $ HS.requestPath request
-    (ps, query) = HTTP.decodePath path
-    getHello = respond "OK"
-    sendCommand = execChatCommand (bodyHead reqBody) >>= respondJSON
-    recvMessage =
-      chatReadVar remoteCtrlSession >>= \case
-        Nothing -> respondWith Status.internalServerError500 "session not active"
-        Just rcs -> atomically (readTBQueue $ remoteOutputQ rcs) >>= respondJSON
-    -- TODO liftEither storeFileQuery
-    storeFile = case storeFileQuery of
-      Left err -> respondWith Status.badRequest400 (Binary.putStringUtf8 err)
-      Right fileName -> do
-        baseDir <- fromMaybe "." <$> chatReadVar filesFolder
-        localPath <- uniqueCombine baseDir fileName
-        logDebug $ "Storing controller file to " <> tshow (baseDir, localPath)
-        writeBodyToFile localPath reqBody
-        let storeRelative = takeFileName localPath
-        respond $ Binary.putStringUtf8 storeRelative
-      where
-        storeFileQuery = parseField "file_name" $ A.many1 (A.satisfy $ not . isPathSeparator)
-    -- TODO move to ExceptT monad, catch errors in one place, convert errors to responses
-    fetchFile = case fetchFileQuery of
-      Left err -> respondWith Status.badRequest400 (Binary.putStringUtf8 err)
-      Right (userId, fileId) -> do
-        logInfo $ "Fetching file " <> tshow fileId <> " from user " <> tshow userId
-        x <- withStore' $ \db -> runExceptT $ do
-          user <- getUser db userId
-          getRcvFileTransfer db user fileId
-        -- TODO this error handling is very ad-hoc, there is no separation between Chat errors and responses
-        case x of
-          Right RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}} -> do
-            baseDir <- fromMaybe "." <$> chatReadVar filesFolder
-            let fullPath = baseDir </> filePath
-            size <- fromInteger <$> getFileSize fullPath
-            liftIO . sendResponse . HS.responseFile Status.ok200 mempty $ HS.FileSpec fullPath 0 size
-          Right _ -> respondWith Status.internalServerError500 "The requested file is not complete"
-          Left SEUserNotFound {} -> respondWith Status.notFound404 "User not found"
-          Left SERcvFileNotFound {} -> respondWith Status.notFound404 "File not found"
-          _ -> respondWith Status.internalServerError500 "Store error"
-      where
-        fetchFileQuery =
-          (,)
-            <$> parseField "user_id" A.decimal
-            <*> parseField "file_id" A.decimal
-
-    parseField :: ByteString -> A.Parser a -> Either String a
-    parseField field p = maybe (Left $ "missing " <> B.unpack field) (A.parseOnly $ p <* A.endOfInput) (join $ lookup field query)
-
-    respondJSON :: (J.ToJSON a) => a -> m ()
-    respondJSON = respond . Binary.fromLazyByteString . J.encode
-
-    respond = respondWith Status.ok200
-    respondWith status = liftIO . sendResponse . HS.responseBuilder status []
-
--- * ChatRequest handlers
-
-startRemoteCtrl :: ChatMonad m => (ByteString -> m ChatResponse) -> m ()
+startRemoteCtrl :: forall m . ChatMonad m => (ByteString -> m ChatResponse) -> m ()
 startRemoteCtrl execChatCommand = do
-  checkNoRemoteCtrlSession
+  logInfo "Starting remote host"
+  checkNoRemoteCtrlSession -- tiny race with the final @chatWriteVar@ until the setup finishes and supervisor spawned
+  discovered <- newTVarIO mempty
+  discoverer <- async $ discoverRemoteCtrls discovered -- TODO extract to a controller service singleton
   size <- asks $ tbqSize . config
   remoteOutputQ <- newTBQueueIO size
-  discovered <- newTVarIO mempty
-  discoverer <- async $ discoverRemoteCtrls discovered
   accepted <- newEmptyTMVarIO
-  supervisor <- async $ runSupervisor discovered accepted
+  supervisor <- async $ runHost discovered accepted $ handleRemoteCommand execChatCommand remoteOutputQ
   chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted, remoteOutputQ}
+
+-- | Track remote host lifecycle in controller session state and signal UI on its progress
+runHost :: ChatMonad m => TM.TMap C.KeyHash TransportHost -> TMVar RemoteCtrlId -> (HTTP2Request -> m ()) -> m ()
+runHost discovered accepted handleHttp = do
+  remoteCtrlId <- atomically (readTMVar accepted) -- wait for ???
+  rc@RemoteCtrl {fingerprint} <- withStore (`getRemoteCtrl` remoteCtrlId)
+  source <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure -- wait for location of the matching fingerprint
+  toView $ CRRemoteCtrlConnecting $ remoteCtrlInfo rc False
+  atomically $ writeTVar discovered mempty -- flush unused sources
+  server <- async $ Discovery.connectRevHTTP2 source fingerprint handleHttp -- spawn server for remote protocol commands
+  chatModifyVar remoteCtrlSession $ fmap $ \s -> s {hostServer = Just server}
+  toView $ CRRemoteCtrlConnected $ remoteCtrlInfo rc True
+  _ <- waitCatch server -- wait for the server to finish
+  chatWriteVar remoteCtrlSession Nothing
+  toView CRRemoteCtrlStopped
+
+handleRemoteCommand :: forall m . ChatMonad m => (ByteString -> m ChatResponse) -> TBQueue ChatResponse -> HTTP2Request -> m ()
+handleRemoteCommand execChatCommand remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
+  logDebug "handleRemoteCommand"
+  liftRC (tryRemoteError parseRequest) >>= \case
+    Right (getNext, rc) -> processCommand getNext rc `catchAny` (reply . RRProtocolError . RPEException . tshow)
+    Left e -> reply $ RRProtocolError e
   where
-    runSupervisor discovered accepted = do
-      remoteCtrlId <- atomically (readTMVar accepted)
-      rc@RemoteCtrl {fingerprint} <- withStore (`getRemoteCtrl` remoteCtrlId)
-      source <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure
-      toView $ CRRemoteCtrlConnecting $ remoteCtrlInfo rc False
-      atomically $ writeTVar discovered mempty -- flush unused sources
-      server <- async $ Discovery.connectRevHTTP2 source fingerprint (processControllerRequest execChatCommand)
-      chatModifyVar remoteCtrlSession $ fmap $ \s -> s {hostServer = Just server}
-      toView $ CRRemoteCtrlConnected $ remoteCtrlInfo rc True
-      _ <- waitCatch server
-      chatWriteVar remoteCtrlSession Nothing
-      toView CRRemoteCtrlStopped
+    parseRequest :: ExceptT RemoteProtocolError IO (GetChunk, RemoteCommand)
+    parseRequest = do
+      (header, getNext) <- parseHTTP2Body request reqBody
+      (getNext,) <$> liftEitherWith (RPEInvalidJSON . T.pack) (J.eitherDecodeStrict' header)
+    processCommand :: GetChunk -> RemoteCommand -> m ()
+    processCommand getNext = \case
+      RCHello {deviceName = desktopName} -> handleHello desktopName >>= reply
+      RCSend {command} -> handleSend execChatCommand command >>= reply
+      RCRecv {wait = time} -> handleRecv time remoteOutputQ >>= reply
+      RCStoreFile {fileSize, encrypt} -> handleStoreFile fileSize encrypt getNext >>= reply
+      RCGetFile {filePath} -> handleGetFile filePath replyWith
+    reply :: RemoteResponse -> m ()
+    reply = (`replyWith` \_ -> pure ())
+    replyWith :: Respond m
+    replyWith rr attach =
+      liftIO . sendResponse . responseStreaming N.status200 [] $ \send flush -> do
+        send $ sizePrefixedEncode rr
+        attach send
+        flush
+
+type GetChunk = Int -> IO ByteString
+
+type SendChunk = Builder -> IO ()
+
+type Respond m = RemoteResponse -> (SendChunk -> IO ()) -> m ()
+
+liftRC :: ChatMonad m => ExceptT RemoteProtocolError IO a -> m a
+liftRC = liftError (ChatErrorRemoteCtrl . RCEProtocolError)
+
+tryRemoteError :: ExceptT RemoteProtocolError IO a -> ExceptT RemoteProtocolError IO (Either RemoteProtocolError a)
+tryRemoteError = tryAllErrors (RPEException . tshow)
+{-# INLINE tryRemoteError #-}
+
+handleHello :: ChatMonad m => Text -> m RemoteResponse
+handleHello desktopName = do
+  logInfo $ "Hello from " <> tshow desktopName
+  mobileName <- chatReadVar localDeviceName
+  pure RRHello {encoding = localEncoding, deviceName = mobileName}
+
+handleSend :: ChatMonad m => (ByteString -> m ChatResponse) -> Text -> m RemoteResponse
+handleSend execChatCommand command = do
+  logDebug $ "Send: " <> tshow command
+  -- execChatCommand checks for remote-allowed commands
+  -- convert errors thrown in ChatMonad into error responses to prevent aborting the protocol wrapper
+  RRChatResponse <$> execChatCommand (encodeUtf8 command) `catchError` (pure . CRChatError Nothing)
+
+handleRecv :: MonadUnliftIO m => Int -> TBQueue ChatResponse -> m RemoteResponse
+handleRecv time events = do
+  logDebug $ "Recv: " <> tshow time
+  RRChatEvent <$> (timeout time . atomically $ readTBQueue events)
+
+handleStoreFile :: ChatMonad m => Word32 -> Maybe Bool -> GetChunk -> m RemoteResponse
+handleStoreFile _fileSize _encrypt _getNext = error "TODO" <$ logError "TODO: handleStoreFile"
+
+handleGetFile :: ChatMonad m => FilePath -> Respond m -> m ()
+handleGetFile path reply = do
+  logDebug $ "GetFile: " <> tshow path
+  withFile path ReadMode $ \h -> do
+    fileSize' <- hFileSize h
+    when (fileSize' > toInteger (maxBound :: Word32)) $ throwIO RPEFileTooLarge
+    let fileSize = fromInteger fileSize'
+    reply RRFile {fileSize} $ \send -> hSendFile h send fileSize
 
 -- TODO the problem with this code was that it wasn't clear where the recursion can happen,
 -- by splitting receiving and processing to two functions it becomes clear
diff --git a/src/Simplex/Chat/Remote/Discovery.hs b/src/Simplex/Chat/Remote/Discovery.hs
index 01c6d12c6..5630c540d 100644
--- a/src/Simplex/Chat/Remote/Discovery.hs
+++ b/src/Simplex/Chat/Remote/Discovery.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -20,6 +21,7 @@ module Simplex.Chat.Remote.Discovery
   )
 where
 
+import Control.Logger.Simple
 import Control.Monad
 import Data.ByteString (ByteString)
 import Data.Default (def)
@@ -27,16 +29,17 @@ import Data.String (IsString)
 import qualified Network.Socket as N
 import qualified Network.TLS as TLS
 import qualified Network.UDP as UDP
+import Simplex.Chat.Remote.Types (Tasks, registerAsync)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Transport (supportedParameters)
 import qualified Simplex.Messaging.Transport as Transport
 import Simplex.Messaging.Transport.Client (TransportHost (..), defaultTransportClientConfig, runTransportClient)
 import Simplex.Messaging.Transport.HTTP2 (defaultHTTP2BufferSize, getHTTP2Body)
-import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError, attachHTTP2Client, connTimeout, defaultHTTP2ClientConfig)
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError (..), attachHTTP2Client, bodyHeadSize, connTimeout, defaultHTTP2ClientConfig)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..), runHTTP2ServerWith)
 import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTransportServer)
-import Simplex.Messaging.Util (whenM)
+import Simplex.Messaging.Util (ifM, tshow, whenM)
 import UnliftIO
 import UnliftIO.Concurrent
 
@@ -53,18 +56,33 @@ pattern BROADCAST_PORT = "5226"
 -- | Announce tls server, wait for connection and attach http2 client to it.
 --
 -- Announcer is started when TLS server is started and stopped when a connection is made.
-announceRevHTTP2 :: StrEncoding a => a -> TLS.Credentials -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
-announceRevHTTP2 invite credentials finishAction = do
+announceRevHTTP2 :: StrEncoding a => Tasks -> a -> TLS.Credentials -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
+announceRevHTTP2 tasks invite credentials finishAction = do
   httpClient <- newEmptyMVar
   started <- newEmptyTMVarIO
   finished <- newEmptyMVar
-  announcer <- async . liftIO . whenM (atomically $ takeTMVar started) $ runAnnouncer (strEncode invite)
-  tlsServer <- startTLSServer started credentials $ \tls -> cancel announcer >> runHTTP2Client finished httpClient tls
-  _ <- forkIO $ do
-    readMVar finished
+  _ <- forkIO $ readMVar finished >> finishAction -- attach external cleanup action to session lock
+  announcer <- async . liftIO . whenM (atomically $ takeTMVar started) $ do
+    logInfo $ "Starting announcer for " <> tshow (strEncode invite)
+    runAnnouncer (strEncode invite)
+  tasks `registerAsync` announcer
+  tlsServer <- startTLSServer started credentials $ \tls -> do
+    logInfo $ "Incoming connection for " <> tshow (strEncode invite)
     cancel announcer
-    cancel tlsServer
-    finishAction
+    runHTTP2Client finished httpClient tls `catchAny` (logError . tshow)
+    logInfo $ "Client finished for " <> tshow (strEncode invite)
+  -- BUG: this should be handled in HTTP2Client wrapper
+  _ <- forkIO $ do
+    waitCatch tlsServer >>= \case
+      Left err | fromException err == Just AsyncCancelled -> logDebug "tlsServer cancelled"
+      Left err -> do
+        logError $ "tlsServer failed to start: " <> tshow err
+        void $ tryPutMVar httpClient $ Left HCNetworkError
+        void . atomically $ tryPutTMVar started False
+      Right () -> pure ()
+    void $ tryPutMVar finished ()
+  tasks `registerAsync` tlsServer
+  logInfo $ "Waiting for client for " <> tshow (strEncode invite)
   readMVar httpClient
 
 -- | Broadcast invite with link-local datagrams
@@ -77,8 +95,7 @@ runAnnouncer inviteBS = do
       UDP.send sock inviteBS
       threadDelay 1000000
 
--- TODO what prevents second client from connecting to the same server?
--- Do we need to start multiple TLS servers for different mobile hosts?
+-- XXX: Do we need to start multiple TLS servers for different mobile hosts?
 startTLSServer :: (MonadUnliftIO m) => TMVar Bool -> TLS.Credentials -> (Transport.TLS -> IO ()) -> m (Async ())
 startTLSServer started credentials = async . liftIO . runTransportServer started BROADCAST_PORT serverParams defaultTransportServerConfig
   where
@@ -92,11 +109,17 @@ startTLSServer started credentials = async . liftIO . runTransportServer started
 
 -- | Attach HTTP2 client and hold the TLS until the attached client finishes.
 runHTTP2Client :: MVar () -> MVar (Either HTTP2ClientError HTTP2Client) -> Transport.TLS -> IO ()
-runHTTP2Client finishedVar clientVar tls = do
-  attachHTTP2Client config ANY_ADDR_V4 BROADCAST_PORT (putMVar finishedVar ()) defaultHTTP2BufferSize tls >>= putMVar clientVar
-  readMVar finishedVar
+runHTTP2Client finishedVar clientVar tls =
+  ifM (isEmptyMVar clientVar)
+    attachClient
+    (logError "HTTP2 session already started on this listener")
   where
-    config = defaultHTTP2ClientConfig { connTimeout = 86400000000 }
+    attachClient = do
+      client <- attachHTTP2Client config ANY_ADDR_V4 BROADCAST_PORT (putMVar finishedVar ()) defaultHTTP2BufferSize tls
+      putMVar clientVar client
+      readMVar finishedVar
+    -- TODO connection timeout
+    config = defaultHTTP2ClientConfig {bodyHeadSize = doNotPrefetchHead, connTimeout = maxBound}
 
 withListener :: (MonadUnliftIO m) => (UDP.ListenSocket -> m a) -> m a
 withListener = bracket openListener (liftIO . UDP.stop)
@@ -122,5 +145,9 @@ attachHTTP2Server :: (MonadUnliftIO m) => (HTTP2Request -> m ()) -> Transport.TL
 attachHTTP2Server processRequest tls = do
   withRunInIO $ \unlift ->
     runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
-      reqBody <- getHTTP2Body r defaultHTTP2BufferSize
+      reqBody <- getHTTP2Body r doNotPrefetchHead
       unlift $ processRequest HTTP2Request {sessionId, request = r, reqBody, sendResponse}
+
+-- | Suppress storing initial chunk in bodyHead, forcing clients and servers to stream chunks
+doNotPrefetchHead :: Int
+doNotPrefetchHead = 0
diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs
new file mode 100644
index 000000000..65a851f71
--- /dev/null
+++ b/src/Simplex/Chat/Remote/Protocol.hs
@@ -0,0 +1,199 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Chat.Remote.Protocol where
+
+import Control.Logger.Simple
+import Control.Monad
+import Control.Monad.Except
+import Data.Aeson ((.=))
+import qualified Data.Aeson as J
+import qualified Data.Aeson.Key as JK
+import qualified Data.Aeson.KeyMap as JM
+import Data.Aeson.TH (deriveJSON)
+import qualified Data.Aeson.Types as JT
+import Data.ByteString (ByteString)
+import Data.ByteString.Builder (Builder, word32BE, lazyByteString)
+import qualified Data.ByteString.Lazy as BL
+import Data.String (fromString)
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8)
+import Data.Word (Word32)
+import qualified Network.HTTP.Types as N
+import qualified Network.HTTP2.Client as H
+import Network.Transport.Internal (decodeWord32)
+import Simplex.Chat.Controller (ChatResponse)
+import Simplex.Chat.Remote.Types
+import Simplex.Messaging.Crypto.File (CryptoFile)
+import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON, pattern SingleFieldJSONTag, pattern TaggedObjectJSONData, pattern TaggedObjectJSONTag)
+import Simplex.Messaging.Transport.Buffer (getBuffered)
+import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), HTTP2BodyChunk, getBodyChunk)
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2Response (..), closeHTTP2Client, sendRequestDirect)
+import Simplex.Messaging.Transport.HTTP2.File (hReceiveFile, hSendFile)
+import Simplex.Messaging.Util (liftEitherError, liftEitherWith, tshow, whenM)
+import System.FilePath ((</>))
+import UnliftIO
+import UnliftIO.Directory (doesFileExist, getFileSize)
+
+data RemoteCommand
+  = RCHello {deviceName :: Text}
+  | RCSend {command :: Text} -- TODO maybe ChatCommand here?
+  | RCRecv {wait :: Int} -- this wait should be less than HTTP timeout
+  | -- local file encryption is determined by the host, but can be overridden for videos
+    RCStoreFile {fileSize :: Word32, encrypt :: Maybe Bool} -- requires attachment
+  | RCGetFile {filePath :: FilePath}
+  deriving (Show)
+
+data RemoteResponse
+  = RRHello {encoding :: PlatformEncoding, deviceName :: Text}
+  | RRChatResponse {chatResponse :: ChatResponse}
+  | RRChatEvent {chatEvent :: Maybe ChatResponse} -- ^ 'Nothing' on poll timeout
+  | RRFileStored {fileSource :: CryptoFile}
+  | RRFile {fileSize :: Word32} -- provides attachment
+  | RRProtocolError {remoteProcotolError :: RemoteProtocolError} -- ^ The protocol error happened on the server side
+  deriving (Show)
+
+-- Force platform-independent encoding as the types aren't UI-visible
+$(deriveJSON (taggedObjectJSON $ dropPrefix "RC") ''RemoteCommand)
+$(deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse)
+
+-- * Client side / desktop
+
+createRemoteHostClient :: HTTP2Client -> Text -> ExceptT RemoteProtocolError IO RemoteHostClient
+createRemoteHostClient httpClient desktopName = do
+  logInfo "Sending initial hello"
+  (_getNext, rr) <- sendRemoteCommand httpClient localEncoding Nothing RCHello {deviceName = desktopName}
+  case rr of
+    rrh@RRHello {encoding, deviceName = mobileName} -> do
+      logInfo $ "Got initial hello: " <> tshow rrh
+      when (encoding == PEKotlin && localEncoding == PESwift) $ throwError RPEIncompatibleEncoding
+      pure RemoteHostClient {remoteEncoding = encoding, remoteDeviceName = mobileName, httpClient}
+    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+
+closeRemoteHostClient :: MonadIO m => RemoteHostClient -> m ()
+closeRemoteHostClient RemoteHostClient {httpClient} = liftIO $ closeHTTP2Client httpClient
+
+-- ** Commands
+
+remoteSend :: RemoteHostClient -> ByteString -> ExceptT RemoteProtocolError IO ChatResponse
+remoteSend RemoteHostClient {httpClient, remoteEncoding} cmd = do
+  (_getNext, rr) <- sendRemoteCommand httpClient remoteEncoding Nothing RCSend {command = decodeUtf8 cmd}
+  case rr of
+    RRChatResponse cr -> pure cr
+    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+
+remoteRecv :: RemoteHostClient -> Int -> ExceptT RemoteProtocolError IO (Maybe ChatResponse)
+remoteRecv RemoteHostClient {httpClient, remoteEncoding} ms = do
+  (_getNext, rr) <- sendRemoteCommand httpClient remoteEncoding Nothing RCRecv {wait=ms}
+  case rr of
+    RRChatEvent cr_ -> pure cr_
+    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+
+remoteStoreFile :: RemoteHostClient -> FilePath -> Maybe Bool -> ExceptT RemoteProtocolError IO CryptoFile
+remoteStoreFile RemoteHostClient {httpClient, remoteEncoding} localPath encrypt = do
+  (_getNext, rr) <- withFile localPath ReadMode $ \h -> do
+    fileSize' <- hFileSize h
+    when (fileSize' > toInteger (maxBound :: Word32)) $ throwError RPEFileTooLarge
+    let fileSize = fromInteger fileSize'
+    sendRemoteCommand httpClient remoteEncoding (Just (h, fileSize)) RCStoreFile {encrypt, fileSize}
+  case rr of
+    RRFileStored {fileSource} -> pure fileSource
+    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+
+-- TODO this should work differently for CLI and UI clients
+-- CLI - potentially, create new unique names and report them as created
+-- UI - always use the same names and report error if file already exists
+-- alternatively, CLI should also use a fixed folder for remote session
+-- Possibly, path in the database should be optional and CLI commands should allow configuring it per session or use temp or download folder
+remoteGetFile :: RemoteHostClient -> FilePath -> FilePath -> ExceptT RemoteProtocolError IO FilePath
+remoteGetFile RemoteHostClient {httpClient, remoteEncoding} baseDir filePath = do
+  (getNext, rr) <- sendRemoteCommand httpClient remoteEncoding Nothing RCGetFile {filePath}
+  expectedSize <- case rr of
+    RRFile {fileSize} -> pure fileSize
+    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+  whenM (liftIO $ doesFileExist localFile) $ throwError RPEStoredFileExists
+  rc <- liftIO $ withFile localFile WriteMode $ \h -> hReceiveFile getNext h expectedSize
+  when (rc /= 0) $ throwError RPEInvalidSize
+  whenM ((== expectedSize) . fromIntegral <$> getFileSize localFile) $ throwError RPEInvalidSize
+  pure localFile
+  where
+    localFile = baseDir </> filePath
+
+sendRemoteCommand :: HTTP2Client -> PlatformEncoding -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO (Int -> IO ByteString, RemoteResponse)
+sendRemoteCommand http remoteEncoding attachment_ rc = do
+  HTTP2Response {response, respBody} <- liftEitherError (RPEHTTP2 . tshow) $ sendRequestDirect http httpRequest Nothing
+  (header, getNext) <- parseHTTP2Body response respBody
+  rr <- liftEitherWith (RPEInvalidJSON . fromString) $ J.eitherDecodeStrict header >>= JT.parseEither J.parseJSON . convertJSON remoteEncoding localEncoding
+  pure (getNext, rr)
+  where
+    httpRequest = H.requestStreaming N.methodPost "/" mempty $ \send flush -> do
+      send $ sizePrefixedEncode rc
+      case attachment_ of
+        Nothing -> pure ()
+        Just (h, sz) -> hSendFile h send sz
+      flush
+
+-- * Transport-level wrappers
+
+convertJSON :: PlatformEncoding -> PlatformEncoding -> J.Value -> J.Value
+convertJSON _remote@PEKotlin _local@PEKotlin = id
+convertJSON PESwift PESwift = id
+convertJSON PESwift PEKotlin = owsf2tagged
+convertJSON PEKotlin PESwift = error "unsupported convertJSON: K/S" -- guarded by createRemoteHostClient
+
+-- | Convert swift single-field sum encoding into tagged/discriminator-field
+owsf2tagged :: J.Value -> J.Value
+owsf2tagged = fst . convert
+  where
+    convert val = case val of
+      J.Object o
+        | JM.size o == 2 ->
+            case JM.toList o of
+              [OwsfTag, o'] -> tagged o'
+              [o', OwsfTag] -> tagged o'
+              _ -> props
+        | otherwise -> props
+        where
+          props = (J.Object $ fmap owsf2tagged o, False)
+      J.Array a -> (J.Array $ fmap owsf2tagged a, False)
+      _ -> (val, False)
+    -- `tagged` converts the pair of single-field object encoding to tagged encoding.
+    -- It sets innerTag returned by `convert` to True to prevent the tag being overwritten.
+    tagged (k, v) = (J.Object pairs, True)
+      where
+        (v', innerTag) = convert v
+        pairs = case v' of
+          -- `innerTag` indicates that internal object already has tag,
+          -- so the current tag cannot be inserted into it.
+          J.Object o
+            | innerTag -> pair
+            | otherwise -> JM.insert TaggedObjectJSONTag tag o
+          _ -> pair
+        tag = J.String $ JK.toText k
+        pair = JM.fromList [TaggedObjectJSONTag .= tag, TaggedObjectJSONData .= v']
+
+pattern OwsfTag :: (JK.Key, J.Value)
+pattern OwsfTag = (SingleFieldJSONTag, J.Bool True)
+
+-- | Convert a command or a response into 'Builder'.
+sizePrefixedEncode :: J.ToJSON a => a -> Builder
+sizePrefixedEncode value = word32BE (fromIntegral $ BL.length json) <> lazyByteString json
+  where
+    json = J.encode value
+
+-- | Parse HTTP request or response to a size-prefixed chunk and a function to read more.
+parseHTTP2Body :: HTTP2BodyChunk a => a -> HTTP2Body -> ExceptT RemoteProtocolError IO (ByteString, Int -> IO ByteString)
+parseHTTP2Body hr HTTP2Body {bodyBuffer} = do
+  rSize <- liftIO $ decodeWord32 <$> getNext 4
+  when (rSize > fromIntegral (maxBound :: Int)) $ throwError RPEInvalidSize
+  r <- liftIO $ getNext $ fromIntegral rSize
+  pure (r, getNext)
+  where
+    getNext sz = getBuffered bodyBuffer sz Nothing $ getBodyChunk hr
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index 67fe7c6ff..de54813a4 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -5,10 +6,39 @@
 
 module Simplex.Chat.Remote.Types where
 
+import Control.Exception
 import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
+import Simplex.Messaging.Parsers (dropPrefix, enumJSON, sumTypeJSON)
+import UnliftIO
+
+data RemoteHostClient = RemoteHostClient
+  { remoteEncoding :: PlatformEncoding,
+    remoteDeviceName :: Text,
+    httpClient :: HTTP2Client
+  }
+
+data RemoteHostSession = RemoteHostSession
+  { remoteHostTasks :: Tasks,
+    remoteHostClient :: Maybe RemoteHostClient,
+    storePath :: FilePath
+  }
+
+data RemoteProtocolError
+  = RPEInvalidSize -- ^ size prefix is malformed
+  | RPEInvalidJSON {invalidJSON :: Text} -- ^ failed to parse RemoteCommand or RemoteResponse
+  | RPEIncompatibleEncoding
+  | RPEUnexpectedFile
+  | RPENoFile
+  | RPEFileTooLarge
+  | RPEUnexpectedResponse {response :: Text} -- ^ Wrong response received for the command sent
+  | RPEStoredFileExists -- ^ A file already exists in the destination position
+  | RPEHTTP2 {http2Error :: Text}
+  | RPEException {someException :: Text}
+  deriving (Show, Exception)
 
 type RemoteHostId = Int64
 
@@ -30,8 +60,6 @@ data RemoteCtrlOOB = RemoteCtrlOOB
   }
   deriving (Show)
 
-$(J.deriveJSON J.defaultOptions ''RemoteCtrlOOB)
-
 data RemoteHostInfo = RemoteHostInfo
   { remoteHostId :: RemoteHostId,
     storePath :: FilePath,
@@ -41,8 +69,6 @@ data RemoteHostInfo = RemoteHostInfo
   }
   deriving (Show)
 
-$(J.deriveJSON J.defaultOptions ''RemoteHostInfo)
-
 type RemoteCtrlId = Int64
 
 data RemoteCtrl = RemoteCtrl
@@ -53,8 +79,6 @@ data RemoteCtrl = RemoteCtrl
   }
   deriving (Show)
 
-$(J.deriveJSON J.defaultOptions {J.omitNothingFields = True} ''RemoteCtrl)
-
 data RemoteCtrlInfo = RemoteCtrlInfo
   { remoteCtrlId :: RemoteCtrlId,
     displayName :: Text,
@@ -64,4 +88,38 @@ data RemoteCtrlInfo = RemoteCtrlInfo
   }
   deriving (Show)
 
+-- TODO: put into a proper place
+data PlatformEncoding
+  = PESwift
+  | PEKotlin
+  deriving (Show, Eq)
+
+localEncoding :: PlatformEncoding
+#if defined(darwin_HOST_OS) && defined(swiftJSON)
+localEncoding = PESwift
+#else
+localEncoding = PEKotlin
+#endif
+
+type Tasks = TVar [Async ()]
+
+asyncRegistered :: MonadUnliftIO m => Tasks -> m () -> m ()
+asyncRegistered tasks action = async action >>= registerAsync tasks
+
+registerAsync :: MonadIO m => Tasks -> Async () -> m ()
+registerAsync tasks = atomically . modifyTVar tasks . (:)
+
+cancelTasks :: (MonadIO m) => Tasks -> m ()
+cancelTasks tasks = readTVarIO tasks >>= mapM_ cancel
+
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "RPE") ''RemoteProtocolError)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "PE") ''PlatformEncoding)
+
+$(J.deriveJSON J.defaultOptions ''RemoteCtrlOOB)
+
+$(J.deriveJSON J.defaultOptions ''RemoteHostInfo)
+
+$(J.deriveJSON J.defaultOptions {J.omitNothingFields = True} ''RemoteCtrl)
+
 $(J.deriveJSON J.defaultOptions {J.omitNothingFields = True} ''RemoteCtrlInfo)
diff --git a/stack.yaml b/stack.yaml
index 6e047f7e6..49aae2639 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: 1ad69cf74f18f25713ce564e1629d2538313b9e0
+    commit: deb3fc73595ceae34902d3402d075e3a531d5221
   - github: kazu-yamamoto/http2
     commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
   # - ../direct-sqlcipher
diff --git a/tests/JSONTests.hs b/tests/JSONTests.hs
index a250cdfcf..188fe2759 100644
--- a/tests/JSONTests.hs
+++ b/tests/JSONTests.hs
@@ -9,7 +9,7 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import GHC.Generics (Generic)
 import Generic.Random (genericArbitraryU)
 import MobileTests
-import Simplex.Chat.Remote (owsf2tagged)
+import Simplex.Chat.Remote.Protocol (owsf2tagged)
 import Simplex.Messaging.Parsers
 import Test.Hspec
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index b739c1988..452f9ca21 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -8,17 +7,18 @@ module RemoteTests where
 
 import ChatClient
 import ChatTests.Utils
+import Control.Logger.Simple
 import Control.Monad
 import qualified Data.ByteString as B
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as M
-import Debug.Trace
 import Network.HTTP.Types (ok200)
 import qualified Network.HTTP2.Client as C
 import qualified Network.HTTP2.Server as S
 import qualified Network.Socket as N
 import qualified Network.TLS as TLS
 import qualified Simplex.Chat.Controller as Controller
+import Simplex.Chat.Remote.Types
 import qualified Simplex.Chat.Remote.Discovery as Discovery
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
@@ -27,17 +27,21 @@ import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Response (..), closeHTTP2Client, sendRequest)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
+import Simplex.Messaging.Util
 import System.FilePath (makeRelative, (</>))
 import Test.Hspec
 import UnliftIO
+import UnliftIO.Concurrent
 import UnliftIO.Directory
 
 remoteTests :: SpecWith FilePath
-remoteTests = fdescribe "Handshake" $ do
+remoteTests = describe "Remote" $ do
   it "generates usable credentials" genCredentialsTest
   it "connects announcer with discoverer over reverse-http2" announceDiscoverHttp2Test
-  it "connects desktop and mobile" remoteHandshakeTest
-  it "send messages via remote desktop" remoteCommandTest
+  it "performs protocol handshake" remoteHandshakeTest
+  it "performs protocol handshake (again)" remoteHandshakeTest -- leaking servers regression check
+  it "sends messages" remoteMessageTest
+  xit "sends files" remoteFileTest
 
 -- * Low-level TLS with ephemeral credentials
 
@@ -51,14 +55,14 @@ genCredentialsTest _tmp = do
     Discovery.connectTLSClient "127.0.0.1" fingerprint clientHandler
   where
     serverHandler serverTls = do
-      traceM "    - Sending from server"
+      logNote "Sending from server"
       Transport.putLn serverTls "hi client"
-      traceM "    - Reading from server"
+      logNote "Reading from server"
       Transport.getLn serverTls `shouldReturn` "hi server"
     clientHandler clientTls = do
-      traceM "    - Sending from client"
+      logNote "Sending from client"
       Transport.putLn clientTls "hi server"
-      traceM "    - Reading from client"
+      logNote "Reading from client"
       Transport.getLn clientTls `shouldReturn` "hi client"
 
 -- * UDP discovery and rever HTTP2
@@ -66,34 +70,37 @@ genCredentialsTest _tmp = do
 announceDiscoverHttp2Test :: (HasCallStack) => FilePath -> IO ()
 announceDiscoverHttp2Test _tmp = do
   (fingerprint, credentials) <- genTestCredentials
+  tasks <- newTVarIO []
   finished <- newEmptyMVar
   controller <- async $ do
-    traceM "    - Controller: starting"
+    logNote "Controller: starting"
     bracket
-      (Discovery.announceRevHTTP2 fingerprint credentials (putMVar finished ()) >>= either (fail . show) pure)
+      (Discovery.announceRevHTTP2 tasks fingerprint credentials (putMVar finished ()) >>= either (fail . show) pure)
       closeHTTP2Client
       ( \http -> do
-          traceM "    - Controller: got client"
+          logNote "Controller: got client"
           sendRequest http (C.requestNoBody "GET" "/" []) (Just 10000000) >>= \case
             Left err -> do
-              traceM "    - Controller: got error"
+              logNote "Controller: got error"
               fail $ show err
             Right HTTP2Response {} ->
-              traceM "    - Controller: got response"
+              logNote "Controller: got response"
       )
   host <- async $ Discovery.withListener $ \sock -> do
     (N.SockAddrInet _port addr, invite) <- Discovery.recvAnnounce sock
     strDecode invite `shouldBe` Right fingerprint
-    traceM "    - Host: connecting"
+    logNote "Host: connecting"
     server <- async $ Discovery.connectTLSClient (THIPv4 $ N.hostAddressToTuple addr) fingerprint $ \tls -> do
-      traceM "    - Host: got tls"
+      logNote "Host: got tls"
       flip Discovery.attachHTTP2Server tls $ \HTTP2Request {sendResponse} -> do
-        traceM "    - Host: got request"
+        logNote "Host: got request"
         sendResponse $ S.responseNoBody ok200 []
-        traceM "    - Host: sent response"
+        logNote "Host: sent response"
     takeMVar finished `finally` cancel server
-    traceM "    - Host: finished"
-  (waitBoth host controller `shouldReturn` ((), ())) `onException` (cancel host >> cancel controller)
+    logNote "Host: finished"
+  tasks `registerAsync` controller
+  tasks `registerAsync` host
+  (waitBoth host controller `shouldReturn` ((), ())) `finally` cancelTasks tasks
 
 -- * Chat commands
 
@@ -101,62 +108,59 @@ remoteHandshakeTest :: (HasCallStack) => FilePath -> IO ()
 remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   desktop ##> "/list remote hosts"
   desktop <## "No remote hosts"
-  desktop ##> "/create remote host"
-  desktop <## "remote host 1 created"
-  desktop <## "connection code:"
-  fingerprint <- getTermLine desktop
+
+  startRemote mobile desktop
+
+  logNote "Session active"
 
   desktop ##> "/list remote hosts"
   desktop <## "Remote hosts:"
-  desktop <## "1. TODO" -- TODO host name probably should be Maybe, as when host is created there is no name yet
-  desktop ##> "/start remote host 1"
-  desktop <## "ok"
-
-  mobile ##> "/start remote ctrl"
-  mobile <## "ok"
-  mobile <## "remote controller announced"
-  mobile <## "connection code:"
-  fingerprint' <- getTermLine mobile
-  fingerprint' `shouldBe` fingerprint
-  mobile ##> "/list remote ctrls"
-  mobile <## "No remote controllers"
-  mobile ##> ("/register remote ctrl " <> fingerprint' <> " " <> "My desktop")
-  mobile <## "remote controller 1 registered"
-  mobile ##> "/list remote ctrls"
-  mobile <## "Remote controllers:"
-  mobile <## "1. My desktop"
-  mobile ##> "/accept remote ctrl 1"
-  mobile <## "ok" -- alternative scenario: accepted before controller start
-  mobile <## "remote controller 1 connecting to My desktop"
-  mobile <## "remote controller 1 connected, My desktop"
-
-  traceM "    - Session active"
-  desktop ##> "/list remote hosts"
-  desktop <## "Remote hosts:"
-  desktop <## "1. TODO (active)"
+  desktop <## "1.  (active)"
   mobile ##> "/list remote ctrls"
   mobile <## "Remote controllers:"
   mobile <## "1. My desktop (active)"
 
-  traceM "    - Shutting desktop"
-  desktop ##> "/stop remote host 1"
-  desktop <## "ok"
+  stopMobile mobile desktop `catchAny` (logError . tshow)
+  -- TODO: add a case for 'stopDesktop'
+
   desktop ##> "/delete remote host 1"
   desktop <## "ok"
   desktop ##> "/list remote hosts"
   desktop <## "No remote hosts"
 
-  traceM "    - Shutting mobile"
-  mobile ##> "/stop remote ctrl"
-  mobile <## "ok"
-  mobile <## "remote controller stopped"
   mobile ##> "/delete remote ctrl 1"
   mobile <## "ok"
   mobile ##> "/list remote ctrls"
   mobile <## "No remote controllers"
 
-remoteCommandTest :: (HasCallStack) => FilePath -> IO ()
-remoteCommandTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
+remoteMessageTest :: (HasCallStack) => FilePath -> IO ()
+remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
+  startRemote mobile desktop
+  contactBob desktop bob
+
+  logNote "sending messages"
+  desktop #> "@bob hello there 🙂"
+  bob <# "alice> hello there 🙂"
+  bob #> "@alice hi"
+  desktop <# "bob> hi"
+
+  logNote "post-remote checks"
+  stopMobile mobile desktop
+
+  mobile ##> "/contacts"
+  mobile <## "bob (Bob)"
+
+  bob ##> "/contacts"
+  bob <## "alice (Alice)"
+
+  desktop ##> "/contacts"
+  -- empty contact list on desktop-local
+
+  threadDelay 1000000
+  logNote "done"
+
+remoteFileTest :: (HasCallStack) => FilePath -> IO ()
+remoteFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
   let mobileFiles = "./tests/tmp/mobile_files"
   mobile ##> ("/_files_folder " <> mobileFiles)
   mobile <## "ok"
@@ -167,6 +171,89 @@ remoteCommandTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
   bob ##> ("/_files_folder " <> bobFiles)
   bob <## "ok"
 
+  startRemote mobile desktop
+  contactBob desktop bob
+
+  rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
+  desktopStore <- case M.lookup 1 rhs of
+    Just RemoteHostSession {storePath} -> pure storePath
+    _ -> fail "Host session 1 should be started"
+
+  doesFileExist "./tests/tmp/mobile_files/test.pdf" `shouldReturn` False
+  doesFileExist (desktopFiles </> desktopStore </> "test.pdf") `shouldReturn` False
+  mobileName <- userName mobile
+
+  bobsFile <- makeRelative bobFiles <$> makeAbsolute "tests/fixtures/test.pdf"
+  bob #> ("/f @" <> mobileName <> " " <> bobsFile)
+  bob <## "use /fc 1 to cancel sending"
+
+  desktop <# "bob> sends file test.pdf (266.0 KiB / 272376 bytes)"
+  desktop <## "use /fr 1 [<dir>/ | <path>] to receive it"
+  desktop ##> "/fr 1"
+  concurrentlyN_
+    [ do
+        bob <## "started sending file 1 (test.pdf) to alice"
+        bob <## "completed sending file 1 (test.pdf) to alice",
+      do
+        desktop <## "saving file 1 from bob to test.pdf"
+        desktop <## "started receiving file 1 (test.pdf) from bob"
+    ]
+  let desktopReceived = desktopFiles </> desktopStore </> "test.pdf"
+  -- desktop <## ("completed receiving file 1 (" <> desktopReceived <> ") from bob")
+  desktop <## "completed receiving file 1 (test.pdf) from bob"
+  bobsFileSize <- getFileSize bobsFile
+  -- getFileSize desktopReceived `shouldReturn` bobsFileSize
+  bobsFileBytes <- B.readFile bobsFile
+  -- B.readFile desktopReceived `shouldReturn` bobsFileBytes
+
+  -- test file transit on mobile
+  mobile ##> "/fs 1"
+  mobile <## "receiving file 1 (test.pdf) complete, path: test.pdf"
+  getFileSize (mobileFiles </> "test.pdf") `shouldReturn` bobsFileSize
+  B.readFile (mobileFiles </> "test.pdf") `shouldReturn` bobsFileBytes
+
+  logNote "file received"
+
+  desktopFile <- makeRelative desktopFiles <$> makeAbsolute "tests/fixtures/logo.jpg" -- XXX: not necessary for _send, but required for /f
+  logNote $ "sending " <> tshow desktopFile
+  doesFileExist (bobFiles </> "logo.jpg") `shouldReturn` False
+  doesFileExist (mobileFiles </> "logo.jpg") `shouldReturn` False
+  desktop ##> "/_send @2 json {\"filePath\": \"./tests/fixtures/logo.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"hi, sending a file\"}}"
+  desktop <# "@bob hi, sending a file"
+  desktop <# "/f @bob logo.jpg"
+  desktop <## "use /fc 2 to cancel sending"
+
+  bob <# "alice> hi, sending a file"
+  bob <# "alice> sends file logo.jpg (31.3 KiB / 32080 bytes)"
+  bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
+  bob ##> "/fr 2"
+  concurrentlyN_
+    [ do
+        bob <## "saving file 2 from alice to logo.jpg"
+        bob <## "started receiving file 2 (logo.jpg) from alice"
+        bob <## "completed receiving file 2 (logo.jpg) from alice"
+        bob ##> "/fs 2"
+        bob <## "receiving file 2 (logo.jpg) complete, path: logo.jpg",
+      do
+        desktop <## "started sending file 2 (logo.jpg) to bob"
+        desktop <## "completed sending file 2 (logo.jpg) to bob"
+    ]
+  desktopFileSize <- getFileSize desktopFile
+  getFileSize (bobFiles </> "logo.jpg") `shouldReturn` desktopFileSize
+  getFileSize (mobileFiles </> "logo.jpg") `shouldReturn` desktopFileSize
+
+  desktopFileBytes <- B.readFile desktopFile
+  B.readFile (bobFiles </> "logo.jpg") `shouldReturn` desktopFileBytes
+  B.readFile (mobileFiles </> "logo.jpg") `shouldReturn` desktopFileBytes
+
+  logNote "file sent"
+
+  stopMobile mobile desktop
+
+-- * Utils
+
+startRemote :: TestCC -> TestCC -> IO ()
+startRemote mobile desktop = do
   desktop ##> "/create remote host"
   desktop <## "remote host 1 created"
   desktop <## "connection code:"
@@ -189,7 +276,9 @@ remoteCommandTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
   mobile <## "remote controller 1 connected, My desktop"
   desktop <## "remote host 1 connected"
 
-  traceM "    - exchanging contacts"
+contactBob :: TestCC -> TestCC -> IO ()
+contactBob desktop bob = do
+  logNote "exchanging contacts"
   bob ##> "/c"
   inv' <- getInvitation bob
   desktop ##> ("/c " <> inv')
@@ -198,102 +287,33 @@ remoteCommandTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
     (desktop <## "bob (Bob): contact is connected")
     (bob <## "alice (Alice): contact is connected")
 
-  traceM "    - sending messages"
-  desktop #> "@bob hello there 🙂"
-  bob <# "alice> hello there 🙂"
-  bob #> "@alice hi"
-  desktop <# "bob> hi"
-
-  withXFTPServer $ do
-    rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
-    desktopStore <- case M.lookup 1 rhs of
-      Just Controller.RemoteHostSessionStarted {storePath} -> pure storePath
-      _ -> fail "Host session 1 should be started"
-
-    doesFileExist "./tests/tmp/mobile_files/test.pdf" `shouldReturn` False
-    doesFileExist (desktopFiles </> desktopStore </> "test.pdf") `shouldReturn` False
-    mobileName <- userName mobile
-
-    bobsFile <- makeRelative bobFiles <$> makeAbsolute "tests/fixtures/test.pdf"
-    bob #> ("/f @" <> mobileName <> " " <> bobsFile)
-    bob <## "use /fc 1 to cancel sending"
-
-    desktop <# "bob> sends file test.pdf (266.0 KiB / 272376 bytes)"
-    desktop <## "use /fr 1 [<dir>/ | <path>] to receive it"
-    desktop ##> "/fr 1"
-    concurrently_
-      do
-        bob <## "started sending file 1 (test.pdf) to alice"
-        bob <## "completed sending file 1 (test.pdf) to alice"
-
-      do
-        desktop <## "saving file 1 from bob to test.pdf"
-        desktop <## "started receiving file 1 (test.pdf) from bob"
-
-    let desktopReceived = desktopFiles </> desktopStore </> "test.pdf"
-    desktop <## ("completed receiving file 1 (" <> desktopReceived <> ") from bob")
-    bobsFileSize <- getFileSize bobsFile
-    getFileSize desktopReceived `shouldReturn` bobsFileSize
-    bobsFileBytes <- B.readFile bobsFile
-    B.readFile desktopReceived `shouldReturn` bobsFileBytes
-
-    -- test file transit on mobile
-    mobile ##> "/fs 1"
-    mobile <## "receiving file 1 (test.pdf) complete, path: test.pdf"
-    getFileSize (mobileFiles </> "test.pdf") `shouldReturn` bobsFileSize
-    B.readFile (mobileFiles </> "test.pdf") `shouldReturn` bobsFileBytes
-
-    traceM "    - file received"
-
-    desktopFile <- makeRelative desktopFiles <$> makeAbsolute "tests/fixtures/logo.jpg" -- XXX: not necessary for _send, but required for /f
-    traceM $ "    - sending " <> show desktopFile
-    doesFileExist (bobFiles </> "logo.jpg") `shouldReturn` False
-    doesFileExist (mobileFiles </> "logo.jpg") `shouldReturn` False
-    desktop ##> "/_send @2 json {\"filePath\": \"./tests/fixtures/logo.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"hi, sending a file\"}}"
-    desktop <# "@bob hi, sending a file"
-    desktop <# "/f @bob logo.jpg"
-    desktop <## "use /fc 2 to cancel sending"
-
-    bob <# "alice> hi, sending a file"
-    bob <# "alice> sends file logo.jpg (31.3 KiB / 32080 bytes)"
-    bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
-    bob ##> "/fr 2"
-    concurrently_
-      do
-        bob <## "saving file 2 from alice to logo.jpg"
-        bob <## "started receiving file 2 (logo.jpg) from alice"
-        bob <## "completed receiving file 2 (logo.jpg) from alice"
-        bob ##> "/fs 2"
-        bob <## "receiving file 2 (logo.jpg) complete, path: logo.jpg"
-      do
-        desktop <## "started sending file 2 (logo.jpg) to bob"
-        desktop <## "completed sending file 2 (logo.jpg) to bob"
-    desktopFileSize <- getFileSize desktopFile
-    getFileSize (bobFiles </> "logo.jpg") `shouldReturn` desktopFileSize
-    getFileSize (mobileFiles </> "logo.jpg") `shouldReturn` desktopFileSize
-
-    desktopFileBytes <- B.readFile desktopFile
-    B.readFile (bobFiles </> "logo.jpg") `shouldReturn` desktopFileBytes
-    B.readFile (mobileFiles </> "logo.jpg") `shouldReturn` desktopFileBytes
-
-    traceM "    - file sent"
-
-  traceM "    - post-remote checks"
-  mobile ##> "/stop remote ctrl"
-  mobile <## "ok"
-  concurrently_
-    (mobile <## "remote controller stopped")
-    (desktop <## "remote host 1 stopped")
-
-  mobile ##> "/contacts"
-  mobile <## "bob (Bob)"
-
-  traceM "    - done"
-
--- * Utils
-
 genTestCredentials :: IO (C.KeyHash, TLS.Credentials)
 genTestCredentials = do
   caCreds <- liftIO $ genCredentials Nothing (0, 24) "CA"
   sessionCreds <- liftIO $ genCredentials (Just caCreds) (0, 24) "Session"
   pure . tlsCredentials $ sessionCreds :| [caCreds]
+
+stopDesktop :: HasCallStack => TestCC -> TestCC -> IO ()
+stopDesktop mobile desktop = do
+  logWarn "stopping via desktop"
+  desktop ##> "/stop remote host 1"
+  -- desktop <## "ok"
+  concurrently_
+    (desktop <## "remote host 1 stopped")
+    (eventually 3 $ mobile <## "remote controller stopped")
+
+stopMobile :: HasCallStack => TestCC -> TestCC -> IO ()
+stopMobile mobile desktop = do
+  logWarn "stopping via mobile"
+  mobile ##> "/stop remote ctrl"
+  mobile <## "ok"
+  concurrently_
+    (mobile <## "remote controller stopped")
+    (eventually 3 $ desktop <## "remote host 1 stopped")
+
+-- | Run action with extended timeout
+eventually :: Int -> IO a -> IO a
+eventually retries action = tryAny action >>= \case -- TODO: only catch timeouts
+  Left err | retries == 0 -> throwIO err
+  Left _ -> eventually (retries - 1) action
+  Right r -> pure r
diff --git a/tests/Test.hs b/tests/Test.hs
index 071ff3791..568f9688d 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ import WebRTCTests
 
 main :: IO ()
 main = do
-  setLogLevel LogError -- LogDebug
+  setLogLevel LogError
   withGlobalLogging logCfg . hspec $ do
     describe "Schema dump" schemaDumpTest
     describe "SimpleX chat markdown" markdownTests
diff --git a/tests/ViewTests.hs b/tests/ViewTests.hs
index 7c7a2f0e0..085a56af4 100644
--- a/tests/ViewTests.hs
+++ b/tests/ViewTests.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module ViewTests where

From e1bd6a93af3bc4b99074d2eef771ae2dbed2f43d Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Mon, 23 Oct 2023 15:44:04 +0300
Subject: [PATCH 21/69] use multicast address for announce (#3241)

* use multicast address for announce

* Add explicit multicast group membership

* join multicast group on a correct side

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 simplex-chat.cabal                    |  1 +
 src/Simplex/Chat/Remote/Discovery.hs  | 43 ++++++++++++++++++---------
 src/Simplex/Chat/Remote/Multicast.hsc | 43 +++++++++++++++++++++++++++
 3 files changed, 73 insertions(+), 14 deletions(-)
 create mode 100644 src/Simplex/Chat/Remote/Multicast.hsc

diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 86e97eabf..f061f8ac8 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -128,6 +128,7 @@ library
       Simplex.Chat.Protocol
       Simplex.Chat.Remote
       Simplex.Chat.Remote.Discovery
+      Simplex.Chat.Remote.Multicast
       Simplex.Chat.Remote.Protocol
       Simplex.Chat.Remote.Types
       Simplex.Chat.Store
diff --git a/src/Simplex/Chat/Remote/Discovery.hs b/src/Simplex/Chat/Remote/Discovery.hs
index 5630c540d..babc65e6a 100644
--- a/src/Simplex/Chat/Remote/Discovery.hs
+++ b/src/Simplex/Chat/Remote/Discovery.hs
@@ -29,6 +29,7 @@ import Data.String (IsString)
 import qualified Network.Socket as N
 import qualified Network.TLS as TLS
 import qualified Network.UDP as UDP
+import Simplex.Chat.Remote.Multicast (setMembership)
 import Simplex.Chat.Remote.Types (Tasks, registerAsync)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
@@ -43,15 +44,15 @@ import Simplex.Messaging.Util (ifM, tshow, whenM)
 import UnliftIO
 import UnliftIO.Concurrent
 
--- | Link-local broadcast address.
-pattern BROADCAST_ADDR_V4 :: (IsString a, Eq a) => a
-pattern BROADCAST_ADDR_V4 = "0.0.0.0"
+-- | mDNS multicast group
+pattern MULTICAST_ADDR_V4 :: (IsString a, Eq a) => a
+pattern MULTICAST_ADDR_V4 = "224.0.0.251"
 
 pattern ANY_ADDR_V4 :: (IsString a, Eq a) => a
 pattern ANY_ADDR_V4 = "0.0.0.0"
 
-pattern BROADCAST_PORT :: (IsString a, Eq a) => a
-pattern BROADCAST_PORT = "5226"
+pattern DISCOVERY_PORT :: (IsString a, Eq a) => a
+pattern DISCOVERY_PORT = "5226"
 
 -- | Announce tls server, wait for connection and attach http2 client to it.
 --
@@ -88,16 +89,17 @@ announceRevHTTP2 tasks invite credentials finishAction = do
 -- | Broadcast invite with link-local datagrams
 runAnnouncer :: ByteString -> IO ()
 runAnnouncer inviteBS = do
-  bracket (UDP.clientSocket BROADCAST_ADDR_V4 BROADCAST_PORT False) UDP.close $ \sock -> do
-    N.setSocketOption (UDP.udpSocket sock) N.Broadcast 1
-    N.setSocketOption (UDP.udpSocket sock) N.ReuseAddr 1
+  bracket (UDP.clientSocket MULTICAST_ADDR_V4 DISCOVERY_PORT False) UDP.close $ \sock -> do
+    let raw = UDP.udpSocket sock
+    N.setSocketOption raw N.Broadcast 1
+    N.setSocketOption raw N.ReuseAddr 1
     forever $ do
       UDP.send sock inviteBS
       threadDelay 1000000
 
 -- XXX: Do we need to start multiple TLS servers for different mobile hosts?
 startTLSServer :: (MonadUnliftIO m) => TMVar Bool -> TLS.Credentials -> (Transport.TLS -> IO ()) -> m (Async ())
-startTLSServer started credentials = async . liftIO . runTransportServer started BROADCAST_PORT serverParams defaultTransportServerConfig
+startTLSServer started credentials = async . liftIO . runTransportServer started DISCOVERY_PORT serverParams defaultTransportServerConfig
   where
     serverParams =
       def
@@ -115,21 +117,34 @@ runHTTP2Client finishedVar clientVar tls =
     (logError "HTTP2 session already started on this listener")
   where
     attachClient = do
-      client <- attachHTTP2Client config ANY_ADDR_V4 BROADCAST_PORT (putMVar finishedVar ()) defaultHTTP2BufferSize tls
+      client <- attachHTTP2Client config ANY_ADDR_V4 DISCOVERY_PORT (putMVar finishedVar ()) defaultHTTP2BufferSize tls
       putMVar clientVar client
       readMVar finishedVar
     -- TODO connection timeout
     config = defaultHTTP2ClientConfig {bodyHeadSize = doNotPrefetchHead, connTimeout = maxBound}
 
 withListener :: (MonadUnliftIO m) => (UDP.ListenSocket -> m a) -> m a
-withListener = bracket openListener (liftIO . UDP.stop)
+withListener = bracket openListener closeListener
 
 openListener :: (MonadIO m) => m UDP.ListenSocket
 openListener = liftIO $ do
-  sock <- UDP.serverSocket (ANY_ADDR_V4, read BROADCAST_PORT)
-  N.setSocketOption (UDP.listenSocket sock) N.Broadcast 1
+  sock <- UDP.serverSocket (MULTICAST_ADDR_V4, read DISCOVERY_PORT)
+  logDebug $ "Discovery listener socket: " <> tshow sock
+  let raw = UDP.listenSocket sock
+  N.setSocketOption raw N.Broadcast 1
+  void $ setMembership raw (listenerHostAddr4 sock) True
   pure sock
 
+closeListener :: MonadIO m => UDP.ListenSocket -> m ()
+closeListener sock = liftIO $ do
+  UDP.stop sock
+  void $ setMembership (UDP.listenSocket sock) (listenerHostAddr4 sock) False
+
+listenerHostAddr4 :: UDP.ListenSocket -> N.HostAddress
+listenerHostAddr4 sock = case UDP.mySockAddr sock of
+  N.SockAddrInet _port host -> host
+  _ -> error "MULTICAST_ADDR_V4 is V4"
+
 recvAnnounce :: (MonadIO m) => UDP.ListenSocket -> m (N.SockAddr, ByteString)
 recvAnnounce sock = liftIO $ do
   (invite, UDP.ClientSockAddr source _cmsg) <- UDP.recvFrom sock
@@ -139,7 +154,7 @@ connectRevHTTP2 :: (MonadUnliftIO m) => TransportHost -> C.KeyHash -> (HTTP2Requ
 connectRevHTTP2 host fingerprint = connectTLSClient host fingerprint . attachHTTP2Server
 
 connectTLSClient :: (MonadUnliftIO m) => TransportHost -> C.KeyHash -> (Transport.TLS -> m a) -> m a
-connectTLSClient host caFingerprint = runTransportClient defaultTransportClientConfig Nothing host BROADCAST_PORT (Just caFingerprint)
+connectTLSClient host caFingerprint = runTransportClient defaultTransportClientConfig Nothing host DISCOVERY_PORT (Just caFingerprint)
 
 attachHTTP2Server :: (MonadUnliftIO m) => (HTTP2Request -> m ()) -> Transport.TLS -> m ()
 attachHTTP2Server processRequest tls = do
diff --git a/src/Simplex/Chat/Remote/Multicast.hsc b/src/Simplex/Chat/Remote/Multicast.hsc
new file mode 100644
index 000000000..ea015c18e
--- /dev/null
+++ b/src/Simplex/Chat/Remote/Multicast.hsc
@@ -0,0 +1,43 @@
+module Simplex.Chat.Remote.Multicast (setMembership) where
+
+import Foreign (Ptr, allocaBytes, castPtr, pokeByteOff)
+import Foreign.C.Types (CInt (..))
+import Network.Socket
+
+#include <HsNet.h>
+
+{- | Toggle multicast group membership.
+
+NB: Group membership is per-host, not per-process. A socket is only used to access system interface for groups.
+-}
+setMembership :: Socket -> HostAddress -> Bool -> IO Bool
+setMembership sock group membership = allocaBytes #{size struct ip_mreq} $ \mReqPtr -> do
+  #{poke struct ip_mreq, imr_multiaddr} mReqPtr group
+  #{poke struct ip_mreq, imr_interface} mReqPtr (0 :: HostAddress) -- attempt to contact the group on ANY interface
+  withFdSocket sock $ \fd ->
+    (/= 0) <$> c_setsockopt fd c_IPPROTO_IP flag (castPtr mReqPtr) (#{size struct ip_mreq})
+  where
+    flag = if membership then c_IP_ADD_MEMBERSHIP else c_IP_DROP_MEMBERSHIP
+
+#ifdef mingw32_HOST_OS
+
+foreign import stdcall unsafe "setsockopt"
+    c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt
+
+c_IP_ADD_MEMBERSHIP, c_IP_DROP_MEMBERSHIP :: CInt
+c_IP_ADD_MEMBERSHIP  = 12
+c_IP_DROP_MEMBERSHIP = 13
+
+#else
+
+foreign import ccall unsafe "setsockopt"
+    c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt
+
+c_IP_ADD_MEMBERSHIP, c_IP_DROP_MEMBERSHIP :: CInt
+c_IP_ADD_MEMBERSHIP  = #const IP_ADD_MEMBERSHIP
+c_IP_DROP_MEMBERSHIP = #const IP_DROP_MEMBERSHIP
+
+#endif
+
+c_IPPROTO_IP :: CInt
+c_IPPROTO_IP = #const IPPROTO_IP

From cd98fabe43579439bb93c712b768ace001174a5e Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Wed, 25 Oct 2023 18:39:46 +0300
Subject: [PATCH 22/69] robust discovery RFC (#3276)

* add new discovery RFC

* update

* update

* update ports

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 docs/rfcs/2023-10-24-robust-discovery.md | 137 +++++++++++++++++++++++
 1 file changed, 137 insertions(+)
 create mode 100644 docs/rfcs/2023-10-24-robust-discovery.md

diff --git a/docs/rfcs/2023-10-24-robust-discovery.md b/docs/rfcs/2023-10-24-robust-discovery.md
new file mode 100644
index 000000000..ff06a12ff
--- /dev/null
+++ b/docs/rfcs/2023-10-24-robust-discovery.md
@@ -0,0 +1,137 @@
+# Robust discovery
+
+## Problem
+
+Remote session protocol has the "discovery" phase where mobile and desktop try to find each other.
+
+Given how easy it is to spoof UDP datagrams extra care should be taken to avoid unauthenticated data.
+In the tech spike for remote sessions, a discovery datagram contains only a TLS key fingerprint.
+While this is enough to operate in a safe environment, the datagram itself should be authenticated.
+
+Using link-local broadcast address of `255.255.255.255` is problematic on MacOS.
+
+The initial implementation effort shown that discovery process better be running as a stand-alone service.
+Additionally, it is desirable to run multiple service announcers in parallel from a single process.
+Each announced service may be a remote controller assigned to a different remote host device, or some other site-local service entirely.
+
+We still want to avoid system interface enumeration due to guesswork involved in filtering them and extra permissions/entitlements required on mobile devices.
+
+## Solution
+
+* An OOB data is extended with a public key to authenticate datagrams.
+* A datagram is extended with MAC envelope, service address and its tag.
+* A site-local multicast group is used for announcement.
+* Additional site-local multicast group is used by announcer to find its own public LAN address.
+
+### Datagram
+
+- `[4]` Version range encoding
+- `[1]` 'A' (Announce)
+- `[8]` systemSeconds of SystemTime encoding - does not change within session.
+- `[2]` Announce counter.
+- `[6]` Service address (host and port).
+- `[1 + 32]` SHA256 fingerprint of CA certificate used to issue per-session TLS certificates.
+- `[1 + ?]` X25519 DH key encoding to agree for per-session encryption inside TLS (hello received in response to hello from controller will contain host DH key).
+- `[1 + ?]` Ed25519 public key used to sign datagram (the host also will receive it in the QR code, it should match this one).
+- `[1 + ?]` Ed25519 signature signing the previous bytes.
+
+"Encoding" here means Encoding class.
+
+That gives ~250 bytes (TBC) that is well under typical MTU of ~1500.
+
+A site-local multicast group `224.0.0.251` is used to announce services on port `5227`.
+
+> The same group and port are used in mDNS (AKA bonjour/avahi/dns-sd/zeroconf) so we expect it to run with most home/SOHO access points without further configuration, although using a different port can make it ineffective.
+
+### OOB data
+
+Announcer MUST include:
+- ED25519 public key used to sign announce datagrams in its OOB link/QR code (also included in datagram, so they can be validated before scanning QR code).
+- the CA certificate fingerprint (also included in datagram).
+- device name for better initial contact UX.
+
+### Discovery announcer
+
+> announcer is run before the controller service.
+>
+> Multiple announcers can send to the same group/port simultaneously.
+
+A typical announce interval is 1 second to balance UI responsiveness with network traffic.
+
+Announcer MUST first discover its own address and validate with the list of local network interfaces.
+
+To discover it's address it will send a datagram with this format:
+
+- `[4]` Version range encoding
+- `[1]` 'I' (Identify)
+- `[1 + 32]` Random number.
+
+Announcer MUST NOT announce a service for a different host.
+
+### Implementation
+
+```
+ChatController {
+    ...
+    multicastSubscribers :: TMVar Int
+    ...
+}
+```
+
+Controller/host connection steps:
+
+1. take multicastSubscribers, if 0 subscribe to multicast group
+2. increase counter and put it back.
+3. send SXC0 datagrams to discover own address.
+4. when received, match address to network interfaces, fail if no match after a few datagrams.
+5. get free port for TCP session.
+6. generate DH key for session.
+7. prepare and start sending signed SXC1 datagrams.
+8. when host connects to the address in the announcement, stop sending datagrams.
+9. take multicastSubscribers, if 1 unsubscribe from multicast group
+10. put back min(0, cnt - 1).
+11. send Hello to host.
+12. get Hello from host with DH key, compute shared secret to be used for remaining  commands and responses.
+
+### Service (TCP server)
+
+A service submits its port/tag/payload to announcer and cancels it when a client connection is established or the service is shut down.
+
+A service SHOULD use system-provided dynamic port (i.e. bind to port `0`) to avoid getting "address in use" errors due to multiple service instances running or another/system service running on a designated port.
+
+### Discovery listener
+
+> TBD: A listener is most certainly a singleton service. But what would its lifetime be?
+> We can run it continously for a snappier discovery and no-brainer client API.
+> Or we can run it on-demand, registering there requests for discovery.
+
+An active listener service receives datagrams and maintains a discovery table mapping service tags and keys to source addresses.
+A service key is derived from the payload, which MAY be used as-is.
+Source address contains both host and port.
+
+Listener MUST verify datagram signature against the key it got in datagram.
+
+Listener MUST verify that the address in the announcement matches the source address of the datagram.
+
+During the first connection to the new controller:
+
+OOB must have the same:
+- Ed25519 key used to sign datagrams.
+- CA cert fingerprint.
+
+During the subsequent connections, these keys and CA cert fingerprint in the datagram mush match the record.
+
+### Service (TCP client)
+
+> TBD: This assumes always-on listener.
+
+A TCP client will use STM to wait for expected service tag and key to appear in discovery table to get its address.
+
+E.g. a remote host on a mobile will wait for the remote profile service with a key fingerprint from OOB.
+
+### Finding own address with multicast
+
+An host with a multicast entitlement may use it to find its own address.
+Receiving your own datagram would reveal source address just as it is used in (unauthenticated) discovery tests.
+
+The same multicast group `224.0.0.251` is used to send "mirror" datagrams on port `5227`.

From 16bda260225d3ee1715b23cf17cda56adb5f4c37 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 26 Oct 2023 15:44:50 +0100
Subject: [PATCH 23/69] core: derive JSON with TH (#3275)

* core: derive JSON with TH

* fix tests

* simplify events

* reduce diff

* fix

* update simplexmq

* update simplexmq
---
 cabal.project                                 |   2 +-
 scripts/nix/sha256map.nix                     |   2 +-
 simplex-chat.cabal                            |   1 +
 src/Simplex/Chat.hs                           |   1 +
 src/Simplex/Chat/Call.hs                      | 135 ++----
 src/Simplex/Chat/Controller.hs                | 286 +++++------
 src/Simplex/Chat/Markdown.hs                  |  42 +-
 src/Simplex/Chat/Messages.hs                  | 445 ++++++++----------
 src/Simplex/Chat/Messages/CIContent.hs        | 184 +-------
 src/Simplex/Chat/Messages/CIContent/Events.hs | 116 +++++
 src/Simplex/Chat/Mobile.hs                    |  40 +-
 src/Simplex/Chat/Mobile/File.hs               |  13 +-
 src/Simplex/Chat/Protocol.hs                  | 120 ++---
 src/Simplex/Chat/Remote/Protocol.hs           |   1 -
 src/Simplex/Chat/Remote/Types.hs              |  11 +-
 src/Simplex/Chat/Store/Profiles.hs            |  17 +-
 src/Simplex/Chat/Store/Shared.hs              |  15 +-
 src/Simplex/Chat/Types.hs                     | 315 +++++--------
 src/Simplex/Chat/Types/Preferences.hs         | 202 ++++----
 src/Simplex/Chat/Types/Util.hs                |   3 -
 src/Simplex/Chat/View.hs                      |  22 +-
 stack.yaml                                    |   2 +-
 tests/MobileTests.hs                          |  10 +-
 23 files changed, 849 insertions(+), 1136 deletions(-)
 create mode 100644 src/Simplex/Chat/Messages/CIContent/Events.hs

diff --git a/cabal.project b/cabal.project
index 5c19fcd44..9cc0a7be6 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: d920a2504b6d4653748da7d297cb13cd0a0f1f48
+    tag: 511d793b927b1e2f12999e0829718671b3a8f0cb
 
 source-repository-package
     type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 26188aa77..658da37f6 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."d920a2504b6d4653748da7d297cb13cd0a0f1f48" = "0r53wn01z044h6myvd458n3hiqsz64kpv59khgybzwdw5mmqnp34";
+  "https://github.com/simplex-chat/simplexmq.git"."511d793b927b1e2f12999e0829718671b3a8f0cb" = "14zk7g33x4a1g5d1dihaklvwzll86ks6fk87kf6l6l5back581zi";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/kazu-yamamoto/http2.git"."804fa283f067bd3fd89b8c5f8d25b3047813a517" = "1j67wp7rfybfx3ryx08z6gqmzj85j51hmzhgx47ihgmgr47sl895";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "0kiwhvml42g9anw4d2v0zd1fpc790pj9syg5x3ik4l97fnkbbwpp";
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index f061f8ac8..e9036ea60 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -36,6 +36,7 @@ library
       Simplex.Chat.Markdown
       Simplex.Chat.Messages
       Simplex.Chat.Messages.CIContent
+      Simplex.Chat.Messages.CIContent.Events
       Simplex.Chat.Migrations.M20220101_initial
       Simplex.Chat.Migrations.M20220122_v1_1
       Simplex.Chat.Migrations.M20220205_chat_item_status
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 2ef5c4356..e8049dcbb 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -58,6 +58,7 @@ import Simplex.Chat.Controller
 import Simplex.Chat.Markdown
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
+import Simplex.Chat.Messages.CIContent.Events
 import Simplex.Chat.Options
 import Simplex.Chat.ProfileGenerator (generateRandomProfile)
 import Simplex.Chat.Protocol
diff --git a/src/Simplex/Chat/Call.hs b/src/Simplex/Chat/Call.hs
index 7e6e60c8f..313442838 100644
--- a/src/Simplex/Chat/Call.hs
+++ b/src/Simplex/Chat/Call.hs
@@ -1,18 +1,18 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
 {-# HLINT ignore "Use newtype instead of data" #-}
 
 module Simplex.Chat.Call where
 
-import Data.Aeson (FromJSON, ToJSON)
-import qualified Data.Aeson as J
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
@@ -20,12 +20,11 @@ import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
 import Simplex.Chat.Types (Contact, ContactId, User)
 import Simplex.Chat.Types.Util (decodeJSON, encodeJSON)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON)
 
 data Call = Call
   { contactId :: ContactId,
@@ -47,14 +46,7 @@ data CallStateTag
   | CSTCallOfferSent
   | CSTCallOfferReceived
   | CSTCallNegotiated
-  deriving (Show, Generic)
-
-instance FromJSON CallStateTag where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CSTCall"
-
-instance ToJSON CallStateTag where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CSTCall"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CSTCall"
+  deriving (Show)
 
 callStateTag :: CallState -> CallStateTag
 callStateTag = \case
@@ -93,21 +85,7 @@ data CallState
         peerCallSession :: WebRTCSession,
         sharedKey :: Maybe C.Key
       }
-  deriving (Show, Generic)
-
--- database representation
-instance FromJSON CallState where
-  parseJSON = J.genericParseJSON $ singleFieldJSON fstToLower
-
-instance ToJSON CallState where
-  toJSON = J.genericToJSON $ singleFieldJSON fstToLower
-  toEncoding = J.genericToEncoding $ singleFieldJSON fstToLower
-
-instance ToField CallState where
-  toField = toField . encodeJSON
-
-instance FromField CallState where
-  fromField = fromTextField_ decodeJSON
+  deriving (Show)
 
 newtype CallId = CallId ByteString
   deriving (Eq, Show)
@@ -135,17 +113,13 @@ data RcvCallInvitation = RcvCallInvitation
     sharedKey :: Maybe C.Key,
     callTs :: UTCTime
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON RcvCallInvitation where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 data CallType = CallType
   { media :: CallMedia,
     capabilities :: CallCapabilities
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 defaultCallType :: CallType
 defaultCallType = CallType CMVideo $ CallCapabilities {encryption = True}
@@ -153,95 +127,54 @@ defaultCallType = CallType CMVideo $ CallCapabilities {encryption = True}
 encryptedCall :: CallType -> Bool
 encryptedCall CallType {capabilities = CallCapabilities {encryption}} = encryption
 
-instance ToJSON CallType where toEncoding = J.genericToEncoding J.defaultOptions
-
 -- | * Types for chat protocol
 data CallInvitation = CallInvitation
   { callType :: CallType,
     callDhPubKey :: Maybe C.PublicKeyX25519
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON CallInvitation where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 data CallMedia = CMAudio | CMVideo
-  deriving (Eq, Show, Generic)
-
-instance FromJSON CallMedia where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CM"
-
-instance ToJSON CallMedia where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CM"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CM"
+  deriving (Eq, Show)
 
 data CallCapabilities = CallCapabilities
   { encryption :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON CallCapabilities where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data CallOffer = CallOffer
   { callType :: CallType,
     rtcSession :: WebRTCSession,
     callDhPubKey :: Maybe C.PublicKeyX25519
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON CallOffer where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 data WebRTCCallOffer = WebRTCCallOffer
   { callType :: CallType,
     rtcSession :: WebRTCSession
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON WebRTCCallOffer where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 data CallAnswer = CallAnswer
   { rtcSession :: WebRTCSession
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON CallAnswer where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data CallExtraInfo = CallExtraInfo
   { rtcExtraInfo :: WebRTCExtraInfo
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON CallExtraInfo where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data WebRTCSession = WebRTCSession
   { rtcSession :: Text, -- LZW compressed JSON encoding of offer or answer
     rtcIceCandidates :: Text -- LZW compressed JSON encoding of array of ICE candidates
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON WebRTCSession where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data WebRTCExtraInfo = WebRTCExtraInfo
   { rtcIceCandidates :: Text -- LZW compressed JSON encoding of array of ICE candidates
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON WebRTCExtraInfo where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data WebRTCCallStatus = WCSConnecting | WCSConnected | WCSDisconnected | WCSFailed
   deriving (Show)
@@ -259,3 +192,37 @@ instance StrEncoding WebRTCCallStatus where
       "disconnected" -> pure WCSDisconnected
       "failed" -> pure WCSFailed
       _ -> fail "bad WebRTCCallStatus"
+
+$(J.deriveJSON (enumJSON $ dropPrefix "CSTCall") ''CallStateTag)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "CM") ''CallMedia)
+
+$(J.deriveJSON defaultJSON ''CallCapabilities)
+
+$(J.deriveJSON defaultJSON ''CallType)
+
+$(J.deriveJSON defaultJSON ''CallInvitation)
+
+$(J.deriveJSON defaultJSON ''WebRTCSession)
+
+$(J.deriveJSON defaultJSON ''CallOffer)
+
+$(J.deriveJSON defaultJSON ''WebRTCCallOffer)
+
+$(J.deriveJSON defaultJSON ''CallAnswer)
+
+$(J.deriveJSON defaultJSON ''WebRTCExtraInfo)
+
+$(J.deriveJSON defaultJSON ''CallExtraInfo)
+
+-- database representation
+$(J.deriveJSON (singleFieldJSON fstToLower) ''CallState)
+
+instance ToField CallState where
+  toField = toField . encodeJSON
+
+instance FromField CallState where
+  fromField = fromTextField_ decodeJSON
+
+$(J.deriveJSON defaultJSON ''RcvCallInvitation)
+
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 1bb28f89d..66ab513a0 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -41,7 +40,6 @@ import Data.String
 import Data.Text (Text)
 import Data.Time (NominalDiffTime, UTCTime)
 import Data.Version (showVersion)
-import GHC.Generics (Generic)
 import Language.Haskell.TH (Exp, Q, runIO)
 import Numeric.Natural
 import qualified Paths_simplex_chat as SC
@@ -67,7 +65,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
 import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, MsgFlags, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServerWithAuth, userProtocol)
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (simplexMQVersion)
@@ -196,14 +194,7 @@ data ChatController = ChatController
   }
 
 data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSIncognito | HSMarkdown | HSMessages | HSSettings | HSDatabase
-  deriving (Show, Generic)
-
-instance FromJSON HelpSection where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "HS"
-
-instance ToJSON HelpSection where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "HS"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "HS"
+  deriving (Show)
 
 data ChatCommand
   = ShowActiveUser
@@ -698,28 +689,14 @@ data ConnectionPlan
   = CPInvitationLink {invitationLinkPlan :: InvitationLinkPlan}
   | CPContactAddress {contactAddressPlan :: ContactAddressPlan}
   | CPGroupLink {groupLinkPlan :: GroupLinkPlan}
-  deriving (Show, Generic)
-
-instance FromJSON ConnectionPlan where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CP"
-
-instance ToJSON ConnectionPlan where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CP"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CP"
+  deriving (Show)
 
 data InvitationLinkPlan
   = ILPOk
   | ILPOwnLink
   | ILPConnecting {contact_ :: Maybe Contact}
   | ILPKnown {contact :: Contact}
-  deriving (Show, Generic)
-
-instance FromJSON InvitationLinkPlan where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "ILP"
-
-instance ToJSON InvitationLinkPlan where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "ILP"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "ILP"
+  deriving (Show)
 
 data ContactAddressPlan
   = CAPOk
@@ -727,14 +704,7 @@ data ContactAddressPlan
   | CAPConnectingConfirmReconnect
   | CAPConnectingProhibit {contact :: Contact}
   | CAPKnown {contact :: Contact}
-  deriving (Show, Generic)
-
-instance FromJSON ContactAddressPlan where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CAP"
-
-instance ToJSON ContactAddressPlan where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CAP"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CAP"
+  deriving (Show)
 
 data GroupLinkPlan
   = GLPOk
@@ -742,14 +712,7 @@ data GroupLinkPlan
   | GLPConnectingConfirmReconnect
   | GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo}
   | GLPKnown {groupInfo :: GroupInfo}
-  deriving (Show, Generic)
-
-instance FromJSON GroupLinkPlan where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "GLP"
-
-instance ToJSON GroupLinkPlan where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "GLP"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "GLP"
+  deriving (Show)
 
 connectionPlanProceed :: ConnectionPlan -> Bool
 connectionPlanProceed = \case
@@ -794,7 +757,7 @@ instance ToJSON AgentQueueId where
   toEncoding = strToJEncoding
 
 data ProtoServersConfig p = ProtoServersConfig {servers :: [ServerCfg p]}
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
 data AProtoServersConfig = forall p. ProtocolTypeI p => APSC (SProtocolType p) (ProtoServersConfig p)
 
@@ -805,36 +768,17 @@ data UserProtoServers p = UserProtoServers
     protoServers :: NonEmpty (ServerCfg p),
     presetServers :: NonEmpty (ProtoServerWithAuth p)
   }
-  deriving (Show, Generic)
-
-instance ProtocolTypeI p => FromJSON (UserProtoServers p) where
-  parseJSON = J.genericParseJSON J.defaultOptions
-
-instance ProtocolTypeI p => ToJSON (UserProtoServers p) where
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data AUserProtoServers = forall p. (ProtocolTypeI p, UserProtocol p) => AUPS (UserProtoServers p)
 
-instance FromJSON AUserProtoServers where
-  parseJSON v = J.withObject "AUserProtoServers" parse v
-    where
-      parse o = do
-        AProtocolType (p :: SProtocolType p) <- o .: "serverProtocol"
-        case userProtocol p of
-          Just Dict -> AUPS <$> J.parseJSON @(UserProtoServers p) v
-          Nothing -> fail $ "AUserProtoServers: unsupported protocol " <> show p
-
-instance ToJSON AUserProtoServers where
-  toJSON (AUPS s) = J.genericToJSON J.defaultOptions s
-  toEncoding (AUPS s) = J.genericToEncoding J.defaultOptions s
-
 deriving instance Show AUserProtoServers
 
 data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool, parentTempDirectory :: Maybe FilePath}
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
 data DBEncryptionConfig = DBEncryptionConfig {currentKey :: DBEncryptionKey, newKey :: DBEncryptionKey}
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
 newtype DBEncryptionKey = DBEncryptionKey String
   deriving (Show)
@@ -852,41 +796,25 @@ data ContactSubStatus = ContactSubStatus
   { contact :: Contact,
     contactError :: Maybe ChatError
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON ContactSubStatus where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 data MemberSubStatus = MemberSubStatus
   { member :: GroupMember,
     memberError :: Maybe ChatError
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON MemberSubStatus where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 data UserContactSubStatus = UserContactSubStatus
   { userContact :: UserContact,
     userContactError :: Maybe ChatError
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON UserContactSubStatus where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 data PendingSubStatus = PendingSubStatus
   { connection :: PendingContactConnection,
     connError :: Maybe ChatError
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON PendingSubStatus where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 data UserProfileUpdateSummary = UserProfileUpdateSummary
   { notChanged :: Int,
@@ -894,16 +822,14 @@ data UserProfileUpdateSummary = UserProfileUpdateSummary
     updateFailures :: Int,
     changedContacts :: [Contact]
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON UserProfileUpdateSummary where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data ComposedMessage = ComposedMessage
   { fileSource :: Maybe CryptoFile,
     quotedItemId :: Maybe ChatItemId,
     msgContent :: MsgContent
   }
-  deriving (Show, Generic)
+  deriving (Show)
 
 -- This instance is needed for backward compatibility, can be removed in v6.0
 instance FromJSON ComposedMessage where
@@ -918,24 +844,16 @@ instance FromJSON ComposedMessage where
   parseJSON invalid =
     JT.prependFailure "bad ComposedMessage, " (JT.typeMismatch "Object" invalid)
 
-instance ToJSON ComposedMessage where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
 data XFTPFileConfig = XFTPFileConfig
   { minFileSize :: Integer
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
 defaultXFTPFileConfig :: XFTPFileConfig
 defaultXFTPFileConfig = XFTPFileConfig {minFileSize = 0}
 
-instance ToJSON XFTPFileConfig where toEncoding = J.genericToEncoding J.defaultOptions
-
 data NtfMsgInfo = NtfMsgInfo {msgTs :: UTCTime, msgFlags :: MsgFlags}
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON NtfMsgInfo where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 crNtfToken :: (DeviceToken, NtfTknStatus, NotificationsMode) -> ChatResponse
 crNtfToken (token, status, ntfMode) = CRNtfToken {token, status, ntfMode}
@@ -945,25 +863,19 @@ data SwitchProgress = SwitchProgress
     switchPhase :: SwitchPhase,
     connectionStats :: ConnectionStats
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON SwitchProgress where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data RatchetSyncProgress = RatchetSyncProgress
   { ratchetSyncStatus :: RatchetSyncState,
     connectionStats :: ConnectionStats
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON RatchetSyncProgress where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data ParsedServerAddress = ParsedServerAddress
   { serverAddress :: Maybe ServerAddress,
     parseError :: String
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON ParsedServerAddress where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data ServerAddress = ServerAddress
   { serverProtocol :: AProtocolType,
@@ -972,9 +884,7 @@ data ServerAddress = ServerAddress
     keyHash :: String,
     basicAuth :: String
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON ServerAddress where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data TimedMessagesEnabled
   = TMEEnableSetTTL Int
@@ -996,22 +906,18 @@ data CoreVersionInfo = CoreVersionInfo
     simplexmqVersion :: String,
     simplexmqCommit :: String
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON CoreVersionInfo where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data SendFileMode
   = SendFileSMP (Maybe InlineFileMode)
   | SendFileXFTP
-  deriving (Show, Generic)
+  deriving (Show)
 
 data SlowSQLQuery = SlowSQLQuery
   { query :: Text,
     queryStats :: SlowQueryStats
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON SlowSQLQuery where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data ChatError
   = ChatError {errorType :: ChatErrorType}
@@ -1020,14 +926,7 @@ data ChatError
   | ChatErrorDatabase {databaseError :: DatabaseError}
   | ChatErrorRemoteCtrl {remoteCtrlError :: RemoteCtrlError}
   | ChatErrorRemoteHost {remoteHostId :: RemoteHostId, remoteHostError :: RemoteHostError}
-  deriving (Show, Exception, Generic)
-
-instance FromJSON ChatError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "Chat"
-
-instance ToJSON ChatError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "Chat"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "Chat"
+  deriving (Show, Exception)
 
 data ChatErrorType
   = CENoActiveUser
@@ -1107,14 +1006,7 @@ data ChatErrorType
   | CEPeerChatVRangeIncompatible
   | CEInternalError {message :: String}
   | CEException {message :: String}
-  deriving (Show, Exception, Generic)
-
-instance FromJSON ChatErrorType where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CE"
-
-instance ToJSON ChatErrorType where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CE"
+  deriving (Show, Exception)
 
 data DatabaseError
   = DBErrorEncrypted
@@ -1122,24 +1014,10 @@ data DatabaseError
   | DBErrorNoFile {dbFile :: String}
   | DBErrorExport {sqliteError :: SQLiteError}
   | DBErrorOpen {sqliteError :: SQLiteError}
-  deriving (Show, Exception, Generic)
-
-instance FromJSON DatabaseError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "DB"
-
-instance ToJSON DatabaseError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "DB"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "DB"
+  deriving (Show, Exception)
 
 data SQLiteError = SQLiteErrorNotADatabase | SQLiteError String
-  deriving (Show, Exception, Generic)
-
-instance FromJSON SQLiteError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SQLite"
-
-instance ToJSON SQLiteError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SQLite"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SQLite"
+  deriving (Show, Exception)
 
 throwDBError :: ChatMonad m => DatabaseError -> m ()
 throwDBError = throwError . ChatErrorDatabase
@@ -1153,14 +1031,7 @@ data RemoteHostError
   | RHDisconnected {reason :: Text} -- ^ A session disconnected by a host
   | RHConnectionLost {reason :: Text} -- ^ A session disconnected due to transport issues
   | RHProtocolError RemoteProtocolError
-  deriving (Show, Exception, Generic)
-
-instance FromJSON RemoteHostError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RH"
-
-instance ToJSON RemoteHostError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RH"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RH"
+  deriving (Show, Exception)
 
 -- TODO review errors, some of it can be covered by HTTP2 errors
 data RemoteCtrlError
@@ -1176,26 +1047,12 @@ data RemoteCtrlError
   | RCEHTTP2RespStatus {statusCode :: Maybe Int} -- TODO remove
   | RCEInvalidResponse {responseError :: String}
   | RCEProtocolError {protocolError :: RemoteProtocolError}
-  deriving (Show, Exception, Generic)
-
-instance FromJSON RemoteCtrlError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RCE"
-
-instance ToJSON RemoteCtrlError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RCE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RCE"
+  deriving (Show, Exception)
 
 data ArchiveError
   = AEImport {chatError :: ChatError}
   | AEImportFile {file :: String, chatError :: ChatError}
-  deriving (Show, Exception, Generic)
-
-instance FromJSON ArchiveError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "AE"
-
-instance ToJSON ArchiveError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "AE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "AE"
+  deriving (Show, Exception)
 
 data RemoteCtrlSession = RemoteCtrlSession
   { -- | Host (mobile) side of transport to process remote commands and forward notifications
@@ -1295,4 +1152,83 @@ withStoreCtx ctx_ action = do
     handleInternal :: String -> SomeException -> IO (Either StoreError a)
     handleInternal ctxStr e = pure . Left . SEInternalError $ show e <> ctxStr
 
+$(JQ.deriveJSON (enumJSON $ dropPrefix "HS") ''HelpSection)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "ILP") ''InvitationLinkPlan)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CAP") ''ContactAddressPlan)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GLP") ''GroupLinkPlan)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CP") ''ConnectionPlan)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CE") ''ChatErrorType)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RH") ''RemoteHostError)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCE") ''RemoteCtrlError)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "SQLite") ''SQLiteError)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "DB") ''DatabaseError)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "Chat") ''ChatError)
+
+$(JQ.deriveJSON defaultJSON ''ContactSubStatus)
+
+$(JQ.deriveJSON defaultJSON ''MemberSubStatus)
+
+$(JQ.deriveJSON defaultJSON ''UserContactSubStatus)
+
+$(JQ.deriveJSON defaultJSON ''PendingSubStatus)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "AE") ''ArchiveError)
+
+$(JQ.deriveJSON defaultJSON ''UserProfileUpdateSummary)
+
+$(JQ.deriveJSON defaultJSON ''NtfMsgInfo)
+
+$(JQ.deriveJSON defaultJSON ''SwitchProgress)
+
+$(JQ.deriveJSON defaultJSON ''RatchetSyncProgress)
+
+$(JQ.deriveJSON defaultJSON ''ServerAddress)
+
+$(JQ.deriveJSON defaultJSON ''ParsedServerAddress)
+
+$(JQ.deriveJSON defaultJSON ''CoreVersionInfo)
+
+$(JQ.deriveJSON defaultJSON ''SlowSQLQuery)
+
+instance ProtocolTypeI p => FromJSON (ProtoServersConfig p) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''ProtoServersConfig)
+
+instance ProtocolTypeI p => FromJSON (UserProtoServers p) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''UserProtoServers)
+
+instance ProtocolTypeI p => ToJSON (UserProtoServers p) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''UserProtoServers)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''UserProtoServers)
+
+instance FromJSON AUserProtoServers where
+  parseJSON v = J.withObject "AUserProtoServers" parse v
+    where
+      parse o = do
+        AProtocolType (p :: SProtocolType p) <- o .: "serverProtocol"
+        case userProtocol p of
+          Just Dict -> AUPS <$> J.parseJSON @(UserProtoServers p) v
+          Nothing -> fail $ "AUserProtoServers: unsupported protocol " <> show p
+
+instance ToJSON AUserProtoServers where
+  toJSON (AUPS s) = $(JQ.mkToJSON defaultJSON ''UserProtoServers) s
+  toEncoding (AUPS s) = $(JQ.mkToEncoding defaultJSON ''UserProtoServers) s
+
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CR") ''ChatResponse)
+
+$(JQ.deriveFromJSON defaultJSON ''ArchiveConfig)
+
+$(JQ.deriveFromJSON defaultJSON ''DBEncryptionConfig)
+
+$(JQ.deriveJSON defaultJSON ''XFTPFileConfig)
+
+$(JQ.deriveToJSON defaultJSON ''ComposedMessage)
diff --git a/src/Simplex/Chat/Markdown.hs b/src/Simplex/Chat/Markdown.hs
index 793fa753e..391f43fa3 100644
--- a/src/Simplex/Chat/Markdown.hs
+++ b/src/Simplex/Chat/Markdown.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
 {-# HLINT ignore "Use newtype instead of data" #-}
@@ -13,6 +13,7 @@ module Simplex.Chat.Markdown where
 import Control.Applicative (optional, (<|>))
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import Data.Attoparsec.Text (Parser)
 import qualified Data.Attoparsec.Text as A
 import Data.Char (isDigit)
@@ -27,12 +28,11 @@ import Data.String
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
-import GHC.Generics
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Util
 import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ConnReqScheme (..), ConnReqUriData (..), ConnectionRequestUri (..), SMPQueue (..))
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fstToLower, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, sumTypeJSON)
 import Simplex.Messaging.Protocol (ProtocolServer (..))
 import Simplex.Messaging.Util (safeDecodeUtf8)
 import System.Console.ANSI.Types
@@ -52,17 +52,10 @@ data Format
   | SimplexLink {linkType :: SimplexLinkType, simplexUri :: Text, smpHosts :: NonEmpty Text}
   | Email
   | Phone
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 data SimplexLinkType = XLContact | XLInvitation | XLGroup
-  deriving (Eq, Show, Generic)
-
-instance FromJSON SimplexLinkType where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "XL"
-
-instance ToJSON SimplexLinkType where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "XL"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "XL"
+  deriving (Eq, Show)
 
 colored :: Color -> Format
 colored = Colored . FormatColor
@@ -70,13 +63,6 @@ colored = Colored . FormatColor
 markdown :: Format -> Text -> Markdown
 markdown = Markdown . Just
 
-instance FromJSON Format where
-  parseJSON = J.genericParseJSON $ sumTypeJSON fstToLower
-
-instance ToJSON Format where
-  toJSON = J.genericToJSON $ sumTypeJSON fstToLower
-  toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
-
 instance Semigroup Markdown where
   m <> (Markdown _ "") = m
   (Markdown _ "") <> m = m
@@ -122,10 +108,7 @@ instance ToJSON FormatColor where
     White -> "white"
 
 data FormattedText = FormattedText {format :: Maybe Format, text :: Text}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON FormattedText where
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 instance IsString FormattedText where
   fromString = FormattedText Nothing . T.pack
@@ -133,11 +116,6 @@ instance IsString FormattedText where
 type MarkdownList = [FormattedText]
 
 data ParsedMarkdown = ParsedMarkdown {formattedText :: Maybe MarkdownList}
-  deriving (Generic)
-
-instance ToJSON ParsedMarkdown where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 unmarked :: Text -> Markdown
 unmarked = Markdown Nothing
@@ -257,3 +235,11 @@ markdownP = mconcat <$> A.many' fragmentP
         linkType' ConnReqUriData {crClientData} = case crClientData >>= decodeJSON of
           Just (CRDataGroup _) -> XLGroup
           Nothing -> XLContact
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "XL") ''SimplexLinkType)
+
+$(JQ.deriveJSON (sumTypeJSON fstToLower) ''Format)
+
+$(JQ.deriveJSON defaultJSON ''FormattedText)
+
+$(JQ.deriveToJSON defaultJSON ''ParsedMarkdown)
diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs
index 8bc302f5d..2718b088b 100644
--- a/src/Simplex/Chat/Messages.hs
+++ b/src/Simplex/Chat/Messages.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
@@ -10,6 +9,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
@@ -20,6 +20,7 @@ import Control.Applicative ((<|>))
 import Data.Aeson (FromJSON, ToJSON, (.:))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
+import qualified Data.Aeson.TH as JQ
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -33,7 +34,6 @@ import Data.Type.Equality
 import Data.Typeable (Typeable)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
 import Simplex.Chat.Markdown
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Protocol
@@ -43,17 +43,15 @@ import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptSta
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, parseAll, enumJSON, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, parseAll, enumJSON, sumTypeJSON)
 import Simplex.Messaging.Protocol (MsgBody)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
 
 data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection
-  deriving (Eq, Show, Ord, Generic)
+  deriving (Eq, Show, Ord)
 
 data ChatName = ChatName {chatType :: ChatType, chatName :: Text}
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON ChatName where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 chatTypeStr :: ChatType -> String
 chatTypeStr = \case
@@ -68,13 +66,6 @@ chatNameStr (ChatName cType name) = chatTypeStr cType <> T.unpack name
 data ChatRef = ChatRef ChatType Int64
   deriving (Eq, Show, Ord)
 
-instance FromJSON ChatType where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CT"
-
-instance ToJSON ChatType where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CT"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CT"
-
 data ChatInfo (c :: ChatType) where
   DirectChat :: Contact -> ChatInfo 'CTDirect
   GroupChat :: GroupInfo -> ChatInfo 'CTGroup
@@ -113,14 +104,8 @@ data JSONChatInfo
   | JCInfoGroup {groupInfo :: GroupInfo}
   | JCInfoContactRequest {contactRequest :: UserContactRequest}
   | JCInfoContactConnection {contactConnection :: PendingContactConnection}
-  deriving (Generic)
 
-instance FromJSON JSONChatInfo where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCInfo"
-
-instance ToJSON JSONChatInfo where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCInfo"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCInfo"
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCInfo") ''JSONChatInfo)
 
 instance ChatTypeI c => FromJSON (ChatInfo c) where
   parseJSON v = (\(AChatInfo _ c) -> checkChatType c) <$?> J.parseJSON v
@@ -163,14 +148,7 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
     reactions :: [CIReactionCount],
     file :: Maybe (CIFile d)
   }
-  deriving (Show, Generic)
-
-instance (ChatTypeI c, MsgDirectionI d) => FromJSON (ChatItem c d) where
-  parseJSON = J.genericParseJSON J.defaultOptions
-
-instance (ChatTypeI c, MsgDirectionI d) => ToJSON (ChatItem c d) where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 isMention :: ChatItem c d -> Bool
 isMention ChatItem {chatDir, quotedItem} = case chatDir of
@@ -195,34 +173,14 @@ deriving instance Show (CIDirection c d)
 
 data CCIDirection c = forall d. MsgDirectionI d => CCID (SMsgDirection d) (CIDirection c d)
 
-instance ChatTypeI c => FromJSON (CCIDirection c) where
-  parseJSON v = (\(ACID _ d x) -> checkChatType (CCID d x)) <$?> J.parseJSON v
-
 data ACIDirection = forall c d. (ChatTypeI c, MsgDirectionI d) => ACID (SChatType c) (SMsgDirection d) (CIDirection c d)
 
-instance FromJSON ACIDirection where
-  parseJSON v = jsonACIDirection <$> J.parseJSON v
-
 data JSONCIDirection
   = JCIDirectSnd
   | JCIDirectRcv
   | JCIGroupSnd
   | JCIGroupRcv {groupMember :: GroupMember}
-  deriving (Generic, Show)
-
-instance FromJSON JSONCIDirection where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCI"
-
-instance ToJSON JSONCIDirection where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCI"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCI"
-
-instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIDirection c d) where
-  parseJSON v = (\(CCID _ x') -> checkDirection x') <$?> J.parseJSON v
-
-instance ToJSON (CIDirection c d) where
-  toJSON = J.toJSON . jsonCIDirection
-  toEncoding = J.toEncoding . jsonCIDirection
+  deriving (Show)
 
 jsonCIDirection :: CIDirection c d -> JSONCIDirection
 jsonCIDirection = \case
@@ -239,26 +197,12 @@ jsonACIDirection = \case
   JCIGroupRcv m -> ACID SCTGroup SMDRcv $ CIGroupRcv m
 
 data CIReactionCount = CIReactionCount {reaction :: MsgReaction, userReacted :: Bool, totalReacted :: Int}
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON CIReactionCount where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data CChatItem c = forall d. MsgDirectionI d => CChatItem (SMsgDirection d) (ChatItem c d)
 
 deriving instance Show (CChatItem c)
 
-instance forall c. ChatTypeI c => FromJSON (CChatItem c) where
-  parseJSON v = J.withObject "CChatItem" parse v
-    where
-      parse o = do
-        CCID d (_ :: CIDirection c d) <- o .: "chatDir"
-        ci <- J.parseJSON @(ChatItem c d) v
-        pure $ CChatItem d ci
-
-instance ChatTypeI c => ToJSON (CChatItem c) where
-  toJSON (CChatItem _ ci) = J.toJSON ci
-  toEncoding (CChatItem _ ci) = J.toEncoding ci
-
 cchatItemId :: CChatItem c -> ChatItemId
 cchatItemId (CChatItem _ ci) = chatItemId' ci
 
@@ -325,51 +269,25 @@ data Chat c = Chat
     chatItems :: [CChatItem c],
     chatStats :: ChatStats
   }
-  deriving (Show, Generic)
-
-instance ChatTypeI c => ToJSON (Chat c) where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data AChat = forall c. ChatTypeI c => AChat (SChatType c) (Chat c)
 
 deriving instance Show AChat
 
-instance FromJSON AChat where
-  parseJSON = J.withObject "AChat" $ \o -> do
-    AChatInfo c chatInfo <- o .: "chatInfo"
-    chatItems <- o .: "chatItems"
-    chatStats <- o .: "chatStats"
-    pure $ AChat c Chat {chatInfo, chatItems, chatStats}
-
-instance ToJSON AChat where
-  toJSON (AChat _ c) = J.toJSON c
-  toEncoding (AChat _ c) = J.toEncoding c
-
 data ChatStats = ChatStats
   { unreadCount :: Int,
     minUnreadItemId :: ChatItemId,
     unreadChat :: Bool
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON ChatStats where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 -- | type to show a mix of messages from multiple chats
 data AChatItem = forall c d. (ChatTypeI c, MsgDirectionI d) => AChatItem (SChatType c) (SMsgDirection d) (ChatInfo c) (ChatItem c d)
 
 deriving instance Show AChatItem
 
-instance FromJSON AChatItem where
-  parseJSON = J.withObject "AChatItem" $ \o -> do
-    AChatInfo c chatInfo <- o .: "chatInfo"
-    CChatItem d chatItem <- o .: "chatItem"
-    pure $ AChatItem c d chatInfo chatItem
-
-instance ToJSON AChatItem where
-  toJSON (AChatItem _ _ chat item) = J.toJSON $ JSONAnyChatItem chat item
-  toEncoding (AChatItem _ _ chat item) = J.toEncoding $ JSONAnyChatItem chat item
-
 data JSONAnyChatItem c d = JSONAnyChatItem {chatInfo :: ChatInfo c, chatItem :: ChatItem c d}
-  deriving (Generic)
 
 aChatItems :: AChat -> [AChatItem]
 aChatItems (AChat ct Chat {chatInfo, chatItems}) = map aChatItem chatItems
@@ -387,10 +305,6 @@ updateFileStatus ci@ChatItem {file} status = case file of
   Just f -> ci {file = Just (f :: CIFile d) {fileStatus = status}}
   Nothing -> ci
 
-instance (ChatTypeI c, MsgDirectionI d) => ToJSON (JSONAnyChatItem c d) where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
-
 -- This type is not saved to DB, so all JSON encodings are platform-specific
 data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
   { itemId :: ChatItemId,
@@ -406,7 +320,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
     createdAt :: UTCTime,
     updatedAt :: UTCTime
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
 mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> CIMeta c d
 mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs createdAt updatedAt =
@@ -415,15 +329,11 @@ mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted item
         _ -> False
    in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, createdAt, updatedAt}
 
-instance ChatTypeI c => ToJSON (CIMeta c d) where toEncoding = J.genericToEncoding J.defaultOptions
-
 data CITimed = CITimed
   { ttl :: Int, -- seconds
     deleteAt :: Maybe UTCTime -- this is initially Nothing for received items, the timer starts when they are read
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON CITimed where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 ttl' :: CITimed -> Int
 ttl' CITimed {ttl} = ttl
@@ -457,14 +367,7 @@ data CIQuote (c :: ChatType) = CIQuote
     content :: MsgContent,
     formattedText :: Maybe MarkdownList
   }
-  deriving (Show, Generic)
-
-instance ChatTypeI c => FromJSON (CIQuote c) where
-  parseJSON = J.genericParseJSON J.defaultOptions
-
-instance ToJSON (CIQuote c) where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 data CIReaction (c :: ChatType) (d :: MsgDirection) = CIReaction
   { chatDir :: CIDirection c d,
@@ -472,41 +375,15 @@ data CIReaction (c :: ChatType) (d :: MsgDirection) = CIReaction
     sentAt :: UTCTime,
     reaction :: MsgReaction
   }
-  deriving (Show, Generic)
-
-instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIReaction c d) where
-  parseJSON = J.genericParseJSON J.defaultOptions
-
-instance ChatTypeI c => ToJSON (CIReaction c d) where
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data AnyCIReaction = forall c d. ChatTypeI c => ACIR (SChatType c) (SMsgDirection d) (CIReaction c d)
 
-instance FromJSON AnyCIReaction where
-  parseJSON v = J.withObject "AnyCIReaction" parse v
-    where
-      parse o = do
-        ACID c d (_ :: CIDirection c d) <- o .: "chatDir"
-        ACIR c d <$> J.parseJSON @(CIReaction c d) v
-
 data ACIReaction = forall c d. ChatTypeI c => ACIReaction (SChatType c) (SMsgDirection d) (ChatInfo c) (CIReaction c d)
 
 deriving instance Show ACIReaction
 
-instance FromJSON ACIReaction where
-  parseJSON = J.withObject "ACIReaction" $ \o -> do
-    ACIR c d reaction <- o .: "chatReaction"
-    cInfo <- o .: "chatInfo"
-    pure $ ACIReaction c d cInfo reaction
-
-instance ToJSON ACIReaction where
-  toJSON (ACIReaction _ _ cInfo reaction) = J.toJSON $ JSONCIReaction cInfo reaction
-  toEncoding (ACIReaction _ _ cInfo reaction) = J.toEncoding $ JSONCIReaction cInfo reaction
-
 data JSONCIReaction c d = JSONCIReaction {chatInfo :: ChatInfo c, chatReaction :: CIReaction c d}
-  deriving (Generic)
-
-instance ChatTypeI c => ToJSON (JSONCIReaction c d) where toEncoding = J.genericToEncoding J.defaultOptions
 
 data CIQDirection (c :: ChatType) where
   CIQDirectSnd :: CIQDirection 'CTDirect
@@ -518,13 +395,6 @@ deriving instance Show (CIQDirection c)
 
 data ACIQDirection = forall c. ChatTypeI c => ACIQDirection (SChatType c) (CIQDirection c)
 
-instance ChatTypeI c => FromJSON (CIQDirection c) where
-  parseJSON v = (\(ACIQDirection _ x) -> checkChatType x) . jsonACIQDirection <$?> J.parseJSON v
-
-instance ToJSON (CIQDirection c) where
-  toJSON = J.toJSON . jsonCIQDirection
-  toEncoding = J.toEncoding . jsonCIQDirection
-
 jsonCIQDirection :: CIQDirection c -> Maybe JSONCIDirection
 jsonCIQDirection = \case
   CIQDirectSnd -> Just JCIDirectSnd
@@ -556,14 +426,7 @@ data CIFile (d :: MsgDirection) = CIFile
     fileStatus :: CIFileStatus d,
     fileProtocol :: FileProtocol
   }
-  deriving (Show, Generic)
-
-instance MsgDirectionI d => FromJSON (CIFile d) where
-  parseJSON = J.genericParseJSON J.defaultOptions
-
-instance MsgDirectionI d => ToJSON (CIFile d) where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 data FileProtocol = FPSMP | FPXFTP
   deriving (Eq, Show, Ord)
@@ -621,17 +484,6 @@ ciFileEnded = \case
   CIFSRcvError -> True
   CIFSInvalid {} -> True
 
-instance MsgDirectionI d => FromJSON (CIFileStatus d) where
-  parseJSON v = (\(AFS _ s) -> checkDirection s) . aciFileStatusJSON <$?> J.parseJSON v
-
-instance ToJSON (CIFileStatus d) where
-  toJSON = J.toJSON . jsonCIFileStatus
-  toEncoding = J.toEncoding . jsonCIFileStatus
-
-instance MsgDirectionI d => ToField (CIFileStatus d) where toField = toField . decodeLatin1 . strEncode
-
-instance FromField ACIFileStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
-
 data ACIFileStatus = forall d. MsgDirectionI d => AFS (SMsgDirection d) (CIFileStatus d)
 
 deriving instance Show ACIFileStatus
@@ -689,14 +541,6 @@ data JSONCIFileStatus
   | JCIFSRcvCancelled
   | JCIFSRcvError
   | JCIFSInvalid {text :: Text}
-  deriving (Generic)
-
-instance FromJSON JSONCIFileStatus where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCIFS"
-
-instance ToJSON JSONCIFileStatus where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIFS"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIFS"
 
 jsonCIFileStatus :: CIFileStatus d -> JSONCIFileStatus
 jsonCIFileStatus = \case
@@ -758,19 +602,6 @@ deriving instance Eq (CIStatus d)
 
 deriving instance Show (CIStatus d)
 
-instance MsgDirectionI d => FromJSON (CIStatus d) where
-  parseJSON v = (\(ACIStatus _ s) -> checkDirection s) . jsonACIStatus <$?> J.parseJSON v
-
-instance ToJSON (CIStatus d) where
-  toJSON = J.toJSON . jsonCIStatus
-  toEncoding = J.toEncoding . jsonCIStatus
-
-instance MsgDirectionI d => ToField (CIStatus d) where toField = toField . decodeLatin1 . strEncode
-
-instance (Typeable d, MsgDirectionI d) => FromField (CIStatus d) where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
-
-instance FromField ACIStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
-
 data ACIStatus = forall d. MsgDirectionI d => ACIStatus (SMsgDirection d) (CIStatus d)
 
 deriving instance Show ACIStatus
@@ -813,14 +644,7 @@ data JSONCIStatus
   | JCISRcvNew
   | JCISRcvRead
   | JCISInvalid {text :: Text}
-  deriving (Show, Generic)
-
-instance FromJSON JSONCIStatus where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCIS"
-
-instance ToJSON JSONCIStatus where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIS"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIS"
+  deriving (Show)
 
 jsonCIStatus :: CIStatus d -> JSONCIStatus
 jsonCIStatus = \case
@@ -872,14 +696,7 @@ membersGroupItemStatus memStatusCounts
 data SndCIStatusProgress
   = SSPPartial
   | SSPComplete
-  deriving (Eq, Show, Generic)
-
-instance FromJSON SndCIStatusProgress where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "SSP"
-
-instance ToJSON SndCIStatusProgress where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "SSP"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "SSP"
+  deriving (Eq, Show)
 
 instance StrEncoding SndCIStatusProgress where
   strEncode = \case
@@ -929,13 +746,6 @@ instance ChatTypeI 'CTContactRequest where chatTypeI = SCTContactRequest
 
 instance ChatTypeI 'CTContactConnection where chatTypeI = SCTContactConnection
 
-instance ChatTypeI c => FromJSON (SChatType c) where
-  parseJSON v = (\(ACT t) -> checkChatType t) . aChatType <$?> J.parseJSON v
-
-instance ToJSON (SChatType c) where
-  toJSON = J.toJSON . toChatType
-  toEncoding = J.toEncoding . toChatType
-
 toChatType :: SChatType c -> ChatType
 toChatType = \case
   SCTDirect -> CTDirect
@@ -1007,9 +817,7 @@ data MsgMetaJSON = MsgMetaJSON
     serverTs :: UTCTime,
     sndId :: Int64
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON MsgMetaJSON where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 msgMetaToJson :: MsgMeta -> MsgMetaJSON
 msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId, serverTs), sndMsgId = sndId} =
@@ -1022,9 +830,6 @@ msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId
       sndId
     }
 
-msgMetaJson :: MsgMeta -> Text
-msgMetaJson = decodeLatin1 . LB.toStrict . J.encode . msgMetaToJson
-
 data MsgDeliveryStatus (d :: MsgDirection) where
   MDSRcvAgent :: MsgDeliveryStatus 'MDRcv
   MDSRcvAcknowledged :: MsgDeliveryStatus 'MDRcv
@@ -1081,25 +886,11 @@ deriving instance Show (CIDeleted c)
 
 data ACIDeleted = forall c. ChatTypeI c => ACIDeleted (SChatType c) (CIDeleted c)
 
-instance ChatTypeI c => FromJSON (CIDeleted c) where
-  parseJSON v = (\(ACIDeleted _ x) -> checkChatType x) . jsonACIDeleted <$?> J.parseJSON v
-
-instance ChatTypeI c => ToJSON (CIDeleted c) where
-  toJSON = J.toJSON . jsonCIDeleted
-  toEncoding = J.toEncoding . jsonCIDeleted
-
 data JSONCIDeleted
   = JCIDDeleted {deletedTs :: Maybe UTCTime, chatType :: ChatType}
   | JCIDBlocked {deletedTs :: Maybe UTCTime}
   | JCIDModerated {deletedTs :: Maybe UTCTime, byGroupMember :: GroupMember}
-  deriving (Show, Generic)
-
-instance FromJSON JSONCIDeleted where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCID"
-
-instance ToJSON JSONCIDeleted where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCID"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCID"
+  deriving (Show)
 
 jsonCIDeleted :: forall d. ChatTypeI d => CIDeleted d -> JSONCIDeleted
 jsonCIDeleted = \case
@@ -1123,9 +914,7 @@ data ChatItemInfo = ChatItemInfo
   { itemVersions :: [ChatItemVersion],
     memberDeliveryStatuses :: Maybe [MemberDeliveryStatus]
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON ChatItemInfo where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data ChatItemVersion = ChatItemVersion
   { chatItemVersionId :: Int64,
@@ -1134,9 +923,7 @@ data ChatItemVersion = ChatItemVersion
     itemVersionTs :: UTCTime,
     createdAt :: UTCTime
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON ChatItemVersion where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 mkItemVersion :: ChatItem c d -> Maybe ChatItemVersion
 mkItemVersion ChatItem {content, meta} = version <$> ciMsgContent content
@@ -1155,9 +942,7 @@ data MemberDeliveryStatus = MemberDeliveryStatus
   { groupMemberId :: GroupMemberId,
     memberDeliveryStatus :: CIStatus 'MDSnd
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON MemberDeliveryStatus where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data CIModeration = CIModeration
   { moderationId :: Int64,
@@ -1166,3 +951,187 @@ data CIModeration = CIModeration
     moderatedAt :: UTCTime
   }
   deriving (Show)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "CT") ''ChatType)
+
+instance ChatTypeI c => FromJSON (SChatType c) where
+  parseJSON v = (\(ACT t) -> checkChatType t) . aChatType <$?> J.parseJSON v
+
+instance ToJSON (SChatType c) where
+  toJSON = J.toJSON . toChatType
+  toEncoding = J.toEncoding . toChatType
+
+$(JQ.deriveJSON defaultJSON ''ChatName)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCID") ''JSONCIDeleted)
+
+instance ChatTypeI c => FromJSON (CIDeleted c) where
+  parseJSON v = (\(ACIDeleted _ x) -> checkChatType x) . jsonACIDeleted <$?> J.parseJSON v
+
+instance ChatTypeI c => ToJSON (CIDeleted c) where
+  toJSON = J.toJSON . jsonCIDeleted
+  toEncoding = J.toEncoding . jsonCIDeleted
+
+$(JQ.deriveJSON defaultJSON ''CITimed)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "SSP") ''SndCIStatusProgress)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCIS") ''JSONCIStatus)
+
+instance MsgDirectionI d => FromJSON (CIStatus d) where
+  parseJSON v = (\(ACIStatus _ s) -> checkDirection s) . jsonACIStatus <$?> J.parseJSON v
+
+instance ToJSON (CIStatus d) where
+  toJSON = J.toJSON . jsonCIStatus
+  toEncoding = J.toEncoding . jsonCIStatus
+
+instance MsgDirectionI d => ToField (CIStatus d) where toField = toField . decodeLatin1 . strEncode
+
+instance (Typeable d, MsgDirectionI d) => FromField (CIStatus d) where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
+instance FromField ACIStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
+$(JQ.deriveJSON defaultJSON ''MemberDeliveryStatus)
+
+$(JQ.deriveJSON defaultJSON ''ChatItemVersion)
+
+$(JQ.deriveJSON defaultJSON ''ChatItemInfo)
+
+instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIMeta c d) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''CIMeta)
+
+instance ChatTypeI c => ToJSON (CIMeta c d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''CIMeta)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''CIMeta)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCIFS") ''JSONCIFileStatus)
+
+instance MsgDirectionI d => FromJSON (CIFileStatus d) where
+  parseJSON v = (\(AFS _ s) -> checkDirection s) . aciFileStatusJSON <$?> J.parseJSON v
+
+instance ToJSON (CIFileStatus d) where
+  toJSON = J.toJSON . jsonCIFileStatus
+  toEncoding = J.toEncoding . jsonCIFileStatus
+
+instance MsgDirectionI d => ToField (CIFileStatus d) where toField = toField . decodeLatin1 . strEncode
+
+instance FromField ACIFileStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
+instance MsgDirectionI d => FromJSON (CIFile d) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''CIFile)
+
+instance MsgDirectionI d => ToJSON (CIFile d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''CIFile)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''CIFile)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCI") ''JSONCIDirection)
+
+instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIDirection c d) where
+  parseJSON v = (\(CCID _ x') -> checkDirection x') <$?> J.parseJSON v
+
+instance ToJSON (CIDirection c d) where
+  toJSON = J.toJSON . jsonCIDirection
+  toEncoding = J.toEncoding . jsonCIDirection
+
+instance ChatTypeI c => FromJSON (CCIDirection c) where
+  parseJSON v = (\(ACID _ d x) -> checkChatType (CCID d x)) <$?> J.parseJSON v
+
+instance FromJSON ACIDirection where
+  parseJSON v = jsonACIDirection <$> J.parseJSON v
+
+instance ChatTypeI c => FromJSON (CIQDirection c) where
+  parseJSON v = (\(ACIQDirection _ x) -> checkChatType x) . jsonACIQDirection <$?> J.parseJSON v
+
+instance ToJSON (CIQDirection c) where
+  toJSON = J.toJSON . jsonCIQDirection
+  toEncoding = J.toEncoding . jsonCIQDirection
+
+instance ChatTypeI c => FromJSON (CIQuote c) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''CIQuote)
+
+$(JQ.deriveToJSON defaultJSON ''CIQuote)
+
+$(JQ.deriveJSON defaultJSON ''CIReactionCount)
+
+instance (ChatTypeI c, MsgDirectionI d) => FromJSON (ChatItem c d) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''ChatItem)
+
+instance (ChatTypeI c, MsgDirectionI d) => ToJSON (ChatItem c d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''ChatItem)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''ChatItem)
+
+instance (ChatTypeI c, MsgDirectionI d) => ToJSON (JSONAnyChatItem c d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''JSONAnyChatItem)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''JSONAnyChatItem)
+
+instance FromJSON AChatItem where
+  parseJSON = J.withObject "AChatItem" $ \o -> do
+    AChatInfo c chatInfo <- o .: "chatInfo"
+    CChatItem d chatItem <- o .: "chatItem"
+    pure $ AChatItem c d chatInfo chatItem
+
+instance ToJSON AChatItem where
+  toJSON (AChatItem _ _ chat item) = J.toJSON $ JSONAnyChatItem chat item
+  toEncoding (AChatItem _ _ chat item) = J.toEncoding $ JSONAnyChatItem chat item
+
+instance forall c. ChatTypeI c => FromJSON (CChatItem c) where
+  parseJSON v = J.withObject "CChatItem" parse v
+    where
+      parse o = do
+        CCID d (_ :: CIDirection c d) <- o .: "chatDir"
+        ci <- J.parseJSON @(ChatItem c d) v
+        pure $ CChatItem d ci
+
+instance ChatTypeI c => ToJSON (CChatItem c) where
+  toJSON (CChatItem _ ci) = J.toJSON ci
+  toEncoding (CChatItem _ ci) = J.toEncoding ci
+
+$(JQ.deriveJSON defaultJSON ''ChatStats)
+
+instance ChatTypeI c => ToJSON (Chat c) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''Chat)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''Chat)
+
+instance FromJSON AChat where
+  parseJSON = J.withObject "AChat" $ \o -> do
+    AChatInfo c chatInfo <- o .: "chatInfo"
+    chatItems <- o .: "chatItems"
+    chatStats <- o .: "chatStats"
+    pure $ AChat c Chat {chatInfo, chatItems, chatStats}
+
+instance ToJSON AChat where
+  toJSON (AChat _ c) = J.toJSON c
+  toEncoding (AChat _ c) = J.toEncoding c
+
+instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIReaction c d) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''CIReaction)
+
+instance ChatTypeI c => ToJSON (CIReaction c d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''CIReaction)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''CIReaction)
+
+instance FromJSON AnyCIReaction where
+  parseJSON v = J.withObject "AnyCIReaction" parse v
+    where
+      parse o = do
+        ACID c d (_ :: CIDirection c d) <- o .: "chatDir"
+        ACIR c d <$> J.parseJSON @(CIReaction c d) v
+
+instance ChatTypeI c => ToJSON (JSONCIReaction c d) where
+  toJSON = $(JQ.mkToJSON defaultJSON ''JSONCIReaction)
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''JSONCIReaction)
+
+instance FromJSON ACIReaction where
+  parseJSON = J.withObject "ACIReaction" $ \o -> do
+    ACIR c d reaction <- o .: "chatReaction"
+    cInfo <- o .: "chatInfo"
+    pure $ ACIReaction c d cInfo reaction
+
+instance ToJSON ACIReaction where
+  toJSON (ACIReaction _ _ cInfo reaction) = J.toJSON $ JSONCIReaction cInfo reaction
+  toEncoding (ACIReaction _ _ cInfo reaction) = J.toEncoding $ JSONCIReaction cInfo reaction
+
+$(JQ.deriveJSON defaultJSON ''MsgMetaJSON)
+
+msgMetaJson :: MsgMeta -> Text
+msgMetaJson = decodeLatin1 . LB.toStrict . J.encode . msgMetaToJson
diff --git a/src/Simplex/Chat/Messages/CIContent.hs b/src/Simplex/Chat/Messages/CIContent.hs
index 7836e7232..2ca9d4ca0 100644
--- a/src/Simplex/Chat/Messages/CIContent.hs
+++ b/src/Simplex/Chat/Messages/CIContent.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
@@ -14,9 +13,9 @@
 
 module Simplex.Chat.Messages.CIContent where
 
-import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
-import qualified Data.Aeson.TH  as JQ
+import qualified Data.Aeson.TH as JQ
+import Data.Aeson.Types as JT
 import Data.Int (Int64)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
@@ -24,25 +23,20 @@ import Data.Type.Equality
 import Data.Word (Word32)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
+import Simplex.Chat.Messages.CIContent.Events
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Util
 import Simplex.Messaging.Agent.Protocol (MsgErrorType (..), RatchetSyncState (..), SwitchPhase (..))
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON)
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow, (<$?>))
 
 data MsgDirection = MDRcv | MDSnd
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
-instance FromJSON MsgDirection where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MD"
-
-instance ToJSON MsgDirection where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "MD"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MD"
+$(JQ.deriveJSON (enumJSON $ dropPrefix "MD") ''MsgDirection)
 
 instance FromField AMsgDirection where fromField = fromIntField_ $ fmap fromMsgDirection . msgDirectionIntP
 
@@ -106,14 +100,9 @@ msgDirectionIntP = \case
   _ -> Nothing
 
 data CIDeleteMode = CIDMBroadcast | CIDMInternal
-  deriving (Show, Generic)
+  deriving (Show)
 
-instance ToJSON CIDeleteMode where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CIDM"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CIDM"
-
-instance FromJSON CIDeleteMode where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CIDM"
+$(JQ.deriveJSON (enumJSON $ dropPrefix "CIDM") ''CIDeleteMode)
 
 ciDeleteModeToText :: CIDeleteMode -> Text
 ciDeleteModeToText = \case
@@ -163,14 +152,7 @@ ciMsgContent = \case
   _ -> Nothing
 
 data MsgDecryptError = MDERatchetHeader | MDETooManySkipped | MDERatchetEarlier | MDEOther
-  deriving (Eq, Show, Generic)
-
-instance ToJSON MsgDecryptError where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "MDE"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MDE"
-
-instance FromJSON MsgDecryptError where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MDE"
+  deriving (Eq, Show)
 
 ciRequiresAttention :: forall d. MsgDirectionI d => CIContent d -> Bool
 ciRequiresAttention content = case msgDirection @d of
@@ -204,135 +186,14 @@ ciRequiresAttention content = case msgDirection @d of
     CIRcvModerated -> True
     CIInvalidJSON _ -> False
 
-data RcvGroupEvent
-  = RGEMemberAdded {groupMemberId :: GroupMemberId, profile :: Profile} -- CRJoinedGroupMemberConnecting
-  | RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember
-  | RGEMemberLeft -- CRLeftMember
-  | RGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
-  | RGEUserRole {role :: GroupMemberRole}
-  | RGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRDeletedMember
-  | RGEUserDeleted -- CRDeletedMemberUser
-  | RGEGroupDeleted -- CRGroupDeleted
-  | RGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
-  -- RGEInvitedViaGroupLink chat items are not received - they're created when sending group invitations,
-  -- but being RcvGroupEvent allows them to be assigned to the respective member (and so enable "send direct message")
-  -- and be created as unread without adding / working around new status for sent items
-  | RGEInvitedViaGroupLink -- CRSentGroupInvitationViaLink
-  | RGEMemberCreatedContact -- CRNewMemberContactReceivedInv
-  deriving (Show, Generic)
-
-instance FromJSON RcvGroupEvent where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RGE"
-
-instance ToJSON RcvGroupEvent where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RGE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RGE"
-
-newtype DBRcvGroupEvent = RGE RcvGroupEvent
-
-instance FromJSON DBRcvGroupEvent where
-  parseJSON v = RGE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RGE") v
-
-instance ToJSON DBRcvGroupEvent where
-  toJSON (RGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RGE") v
-  toEncoding (RGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RGE") v
-
-data SndGroupEvent
-  = SGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
-  | SGEUserRole {role :: GroupMemberRole}
-  | SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember
-  | SGEUserLeft -- CRLeftMemberUser
-  | SGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
-  deriving (Show, Generic)
-
-instance FromJSON SndGroupEvent where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SGE"
-
-instance ToJSON SndGroupEvent where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SGE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SGE"
-
-newtype DBSndGroupEvent = SGE SndGroupEvent
-
-instance FromJSON DBSndGroupEvent where
-  parseJSON v = SGE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "SGE") v
-
-instance ToJSON DBSndGroupEvent where
-  toJSON (SGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SGE") v
-  toEncoding (SGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SGE") v
-
-data RcvConnEvent
-  = RCESwitchQueue {phase :: SwitchPhase}
-  | RCERatchetSync {syncStatus :: RatchetSyncState}
-  | RCEVerificationCodeReset
-  deriving (Show, Generic)
-
-data SndConnEvent
-  = SCESwitchQueue {phase :: SwitchPhase, member :: Maybe GroupMemberRef}
-  | SCERatchetSync {syncStatus :: RatchetSyncState, member :: Maybe GroupMemberRef}
-  deriving (Show, Generic)
-
-instance FromJSON RcvConnEvent where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RCE"
-
-instance ToJSON RcvConnEvent where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RCE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RCE"
-
-newtype DBRcvConnEvent = RCE RcvConnEvent
-
-instance FromJSON DBRcvConnEvent where
-  parseJSON v = RCE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RCE") v
-
-instance ToJSON DBRcvConnEvent where
-  toJSON (RCE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RCE") v
-  toEncoding (RCE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RCE") v
-
-instance FromJSON SndConnEvent where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SCE"
-
-instance ToJSON SndConnEvent where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SCE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SCE"
-
-newtype DBSndConnEvent = SCE SndConnEvent
-
-instance FromJSON DBSndConnEvent where
-  parseJSON v = SCE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "SCE") v
-
-instance ToJSON DBSndConnEvent where
-  toJSON (SCE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SCE") v
-  toEncoding (SCE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SCE") v
-
-data RcvDirectEvent =
-  -- RDEProfileChanged {...}
-  RDEContactDeleted
-  deriving (Show, Generic)
-
-instance FromJSON RcvDirectEvent where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RDE"
-
-instance ToJSON RcvDirectEvent where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RDE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RDE"
-
-newtype DBRcvDirectEvent = RDE RcvDirectEvent
-
-instance FromJSON DBRcvDirectEvent where
-  parseJSON v = RDE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RDE") v
-
-instance ToJSON DBRcvDirectEvent where
-  toJSON (RDE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RDE") v
-  toEncoding (RDE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RDE") v
-
 newtype DBMsgErrorType = DBME MsgErrorType
 
 instance FromJSON DBMsgErrorType where
-  parseJSON v = DBME <$> J.genericParseJSON (singleFieldJSON fstToLower) v
+  parseJSON v = DBME <$> $(JQ.mkParseJSON (singleFieldJSON fstToLower) ''MsgErrorType) v
 
 instance ToJSON DBMsgErrorType where
-  toJSON (DBME v) = J.genericToJSON (singleFieldJSON fstToLower) v
-  toEncoding (DBME v) = J.genericToEncoding (singleFieldJSON fstToLower) v
+  toJSON (DBME v) = $(JQ.mkToJSON (singleFieldJSON fstToLower) ''MsgErrorType) v
+  toEncoding (DBME v) = $(JQ.mkToEncoding (singleFieldJSON fstToLower) ''MsgErrorType) v
 
 data CIGroupInvitation = CIGroupInvitation
   { groupId :: GroupId,
@@ -341,25 +202,14 @@ data CIGroupInvitation = CIGroupInvitation
     groupProfile :: GroupProfile,
     status :: CIGroupInvitationStatus
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON CIGroupInvitation where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 data CIGroupInvitationStatus
   = CIGISPending
   | CIGISAccepted
   | CIGISRejected
   | CIGISExpired
-  deriving (Eq, Show, Generic)
-
-instance FromJSON CIGroupInvitationStatus where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CIGIS"
-
-instance ToJSON CIGroupInvitationStatus where
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CIGIS"
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CIGIS"
+  deriving (Eq, Show)
 
 ciContentToText :: CIContent d -> Text
 ciContentToText = \case
@@ -685,6 +535,12 @@ ciCallInfoText status duration = case status of
   CISCallEnded -> "ended " <> durationText duration
   CISCallError -> "error"
 
+$(JQ.deriveJSON (enumJSON $ dropPrefix "MDE") ''MsgDecryptError)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "CIGIS") ''CIGroupInvitationStatus)
+
+$(JQ.deriveJSON defaultJSON ''CIGroupInvitation)
+
 $(JQ.deriveJSON (enumJSON $ dropPrefix "CISCall") ''CICallStatus)
 
 -- platform specific
diff --git a/src/Simplex/Chat/Messages/CIContent/Events.hs b/src/Simplex/Chat/Messages/CIContent/Events.hs
new file mode 100644
index 000000000..42a5add1d
--- /dev/null
+++ b/src/Simplex/Chat/Messages/CIContent/Events.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Chat.Messages.CIContent.Events where
+
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson.TH as J
+import Simplex.Chat.Types
+import Simplex.Messaging.Agent.Protocol (RatchetSyncState (..), SwitchPhase (..))
+import Simplex.Messaging.Parsers (dropPrefix, singleFieldJSON, sumTypeJSON)
+
+data RcvGroupEvent
+  = RGEMemberAdded {groupMemberId :: GroupMemberId, profile :: Profile} -- CRJoinedGroupMemberConnecting
+  | RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember
+  | RGEMemberLeft -- CRLeftMember
+  | RGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
+  | RGEUserRole {role :: GroupMemberRole}
+  | RGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRDeletedMember
+  | RGEUserDeleted -- CRDeletedMemberUser
+  | RGEGroupDeleted -- CRGroupDeleted
+  | RGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
+  -- RGEInvitedViaGroupLink chat items are not received - they're created when sending group invitations,
+  -- but being RcvGroupEvent allows them to be assigned to the respective member (and so enable "send direct message")
+  -- and be created as unread without adding / working around new status for sent items
+  | RGEInvitedViaGroupLink -- CRSentGroupInvitationViaLink
+  | RGEMemberCreatedContact -- CRNewMemberContactReceivedInv
+  deriving (Show)
+
+data SndGroupEvent
+  = SGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
+  | SGEUserRole {role :: GroupMemberRole}
+  | SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember
+  | SGEUserLeft -- CRLeftMemberUser
+  | SGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
+  deriving (Show)
+
+data RcvConnEvent
+  = RCESwitchQueue {phase :: SwitchPhase}
+  | RCERatchetSync {syncStatus :: RatchetSyncState}
+  | RCEVerificationCodeReset
+  deriving (Show)
+
+data SndConnEvent
+  = SCESwitchQueue {phase :: SwitchPhase, member :: Maybe GroupMemberRef}
+  | SCERatchetSync {syncStatus :: RatchetSyncState, member :: Maybe GroupMemberRef}
+  deriving (Show)
+
+data RcvDirectEvent =
+  -- RDEProfileChanged {...}
+  RDEContactDeleted
+  deriving (Show)
+
+-- platform-specific JSON encoding (used in API)
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "RGE") ''RcvGroupEvent)
+
+-- platform-independent JSON encoding (stored in DB)
+newtype DBRcvGroupEvent = RGE RcvGroupEvent
+
+instance FromJSON DBRcvGroupEvent where
+  parseJSON v = RGE <$> $(J.mkParseJSON (singleFieldJSON $ dropPrefix "RGE") ''RcvGroupEvent) v
+
+instance ToJSON DBRcvGroupEvent where
+  toJSON (RGE v) = $(J.mkToJSON (singleFieldJSON $ dropPrefix "RGE") ''RcvGroupEvent) v
+  toEncoding (RGE v) = $(J.mkToEncoding (singleFieldJSON $ dropPrefix "RGE") ''RcvGroupEvent) v
+
+-- platform-specific JSON encoding (used in API)
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "SGE") ''SndGroupEvent)
+
+-- platform-independent JSON encoding (stored in DB)
+newtype DBSndGroupEvent = SGE SndGroupEvent
+
+instance FromJSON DBSndGroupEvent where
+  parseJSON v = SGE <$> $(J.mkParseJSON (singleFieldJSON $ dropPrefix "SGE") ''SndGroupEvent) v
+
+instance ToJSON DBSndGroupEvent where
+  toJSON (SGE v) = $(J.mkToJSON (singleFieldJSON $ dropPrefix "SGE") ''SndGroupEvent) v
+  toEncoding (SGE v) = $(J.mkToEncoding (singleFieldJSON $ dropPrefix "SGE") ''SndGroupEvent) v
+
+-- platform-specific JSON encoding (used in API)
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "RCE") ''RcvConnEvent)
+
+-- platform-independent JSON encoding (stored in DB)
+newtype DBRcvConnEvent = RCE RcvConnEvent
+
+instance FromJSON DBRcvConnEvent where
+  parseJSON v = RCE <$> $(J.mkParseJSON (singleFieldJSON $ dropPrefix "RCE") ''RcvConnEvent) v
+
+instance ToJSON DBRcvConnEvent where
+  toJSON (RCE v) = $(J.mkToJSON (singleFieldJSON $ dropPrefix "RCE") ''RcvConnEvent) v
+  toEncoding (RCE v) = $(J.mkToEncoding (singleFieldJSON $ dropPrefix "RCE") ''RcvConnEvent) v
+
+-- platform-specific JSON encoding (used in API)
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "SCE") ''SndConnEvent)
+
+-- platform-independent JSON encoding (stored in DB)
+newtype DBSndConnEvent = SCE SndConnEvent
+
+instance FromJSON DBSndConnEvent where
+  parseJSON v = SCE <$> $(J.mkParseJSON (singleFieldJSON $ dropPrefix "SCE") ''SndConnEvent) v
+
+instance ToJSON DBSndConnEvent where
+  toJSON (SCE v) = $(J.mkToJSON (singleFieldJSON $ dropPrefix "SCE") ''SndConnEvent) v
+  toEncoding (SCE v) = $(J.mkToEncoding (singleFieldJSON $ dropPrefix "SCE") ''SndConnEvent) v
+
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "RDE") ''RcvDirectEvent)
+
+-- platform-independent JSON encoding (stored in DB)
+newtype DBRcvDirectEvent = RDE RcvDirectEvent
+
+instance FromJSON DBRcvDirectEvent where
+  parseJSON v = RDE <$> $(J.mkParseJSON (singleFieldJSON $ dropPrefix "RDE") ''RcvDirectEvent) v
+
+instance ToJSON DBRcvDirectEvent where
+  toJSON (RDE v) = $(J.mkToJSON (singleFieldJSON $ dropPrefix "RDE") ''RcvDirectEvent) v
+  toEncoding (RDE v) = $(J.mkToEncoding (singleFieldJSON $ dropPrefix "RDE") ''RcvDirectEvent) v
diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs
index 6203d1218..be079af8a 100644
--- a/src/Simplex/Chat/Mobile.hs
+++ b/src/Simplex/Chat/Mobile.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -fobject-code #-}
@@ -13,8 +13,8 @@ import Control.Concurrent.STM
 import Control.Exception (catch, SomeException)
 import Control.Monad.Except
 import Control.Monad.Reader
-import Data.Aeson (ToJSON (..))
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
@@ -32,7 +32,6 @@ import Foreign.Ptr
 import Foreign.StablePtr
 import Foreign.Storable (poke)
 import GHC.IO.Encoding (setLocaleEncoding, setFileSystemEncoding, setForeignEncoding)
-import GHC.Generics (Generic)
 import Simplex.Chat
 import Simplex.Chat.Controller
 import Simplex.Chat.Markdown (ParsedMarkdown (..), parseMaybeMarkdownList)
@@ -50,12 +49,26 @@ import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), Migrati
 import Simplex.Messaging.Client (defaultNetworkConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), BasicAuth (..), CorrId (..), ProtoServerWithAuth (..), ProtocolServer (..))
 import Simplex.Messaging.Util (catchAll, liftEitherWith, safeDecodeUtf8)
 import System.IO (utf8)
 import System.Timeout (timeout)
 
+data DBMigrationResult
+  = DBMOk
+  | DBMInvalidConfirmation
+  | DBMErrorNotADatabase {dbFile :: String}
+  | DBMErrorMigration {dbFile :: String, migrationError :: MigrationError}
+  | DBMErrorSQL {dbFile :: String, migrationSQLError :: String}
+  deriving (Show)
+
+$(JQ.deriveToJSON (sumTypeJSON $ dropPrefix "DBM") ''DBMigrationResult)
+
+data APIResponse = APIResponse {corr :: Maybe CorrId, remoteHostId :: Maybe RemoteHostId, resp :: ChatResponse}
+
+$(JQ.deriveToJSON defaultJSON ''APIResponse)
+
 foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
 
 foreign export ccall "chat_close_store" cChatCloseStore :: StablePtr ChatController -> IO CString
@@ -189,18 +202,6 @@ defaultMobileConfig =
 getActiveUser_ :: SQLiteStore -> IO (Maybe User)
 getActiveUser_ st = find activeUser <$> withTransaction st getUsers
 
-data DBMigrationResult
-  = DBMOk
-  | DBMInvalidConfirmation
-  | DBMErrorNotADatabase {dbFile :: String}
-  | DBMErrorMigration {dbFile :: String, migrationError :: MigrationError}
-  | DBMErrorSQL {dbFile :: String, migrationSQLError :: String}
-  deriving (Show, Generic)
-
-instance ToJSON DBMigrationResult where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "DBM"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "DBM"
-
 chatMigrateInit :: String -> String -> String -> IO (Either DBMigrationResult ChatController)
 chatMigrateInit dbFilePrefix dbKey confirm = runExceptT $ do
   confirmMigrations <- liftEitherWith (const DBMInvalidConfirmation) $ strDecode $ B.pack confirm
@@ -264,10 +265,3 @@ chatPasswordHash pwd salt = either (const "") passwordHash salt'
   where
     salt' = U.decode salt
     passwordHash = U.encode . C.sha512Hash . (pwd <>)
-
-data APIResponse = APIResponse {corr :: Maybe CorrId, remoteHostId :: Maybe RemoteHostId, resp :: ChatResponse}
-  deriving (Generic)
-
-instance ToJSON APIResponse where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
diff --git a/src/Simplex/Chat/Mobile/File.hs b/src/Simplex/Chat/Mobile/File.hs
index 73978549f..99860bbfa 100644
--- a/src/Simplex/Chat/Mobile/File.hs
+++ b/src/Simplex/Chat/Mobile/File.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 
 module Simplex.Chat.Mobile.File
@@ -19,8 +19,8 @@ where
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
-import Data.Aeson (ToJSON)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LB
@@ -32,7 +32,6 @@ import Foreign.C
 import Foreign.Marshal.Alloc (mallocBytes)
 import Foreign.Ptr
 import Foreign.Storable (poke, pokeByteOff)
-import GHC.Generics (Generic)
 import Simplex.Chat.Mobile.Shared
 import Simplex.Chat.Util (chunkSize, encryptFile)
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), CryptoFileHandle, FTCryptoError (..))
@@ -45,9 +44,8 @@ import UnliftIO (Handle, IOMode (..), withFile)
 data WriteFileResult
   = WFResult {cryptoArgs :: CryptoFileArgs}
   | WFError {writeError :: String}
-  deriving (Generic)
 
-instance ToJSON WriteFileResult where toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "WF"
+$(JQ.deriveToJSON (sumTypeJSON $ dropPrefix "WF") ''WriteFileResult)
 
 cChatWriteFile :: CString -> Ptr Word8 -> CInt -> IO CJSONString
 cChatWriteFile cPath ptr len = do
@@ -66,9 +64,6 @@ chatWriteFile path s = do
 data ReadFileResult
   = RFResult {fileSize :: Int}
   | RFError {readError :: String}
-  deriving (Generic)
-
-instance ToJSON ReadFileResult where toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RF"
 
 cChatReadFile :: CString -> CString -> CString -> IO (Ptr Word8)
 cChatReadFile cPath cKey cNonce = do
@@ -141,3 +136,5 @@ chatDecryptFile fromPath keyStr nonceStr toPath = fromLeft "" <$> runCatchExcept
 
 runCatchExceptT :: ExceptT String IO a -> IO (Either String a)
 runCatchExceptT action = runExceptT action `catchAll` (pure . Left . show)
+
+$(JQ.deriveToJSON (sumTypeJSON $ dropPrefix "RF") ''ReadFileResult)
diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs
index 50d58b2a4..268729935 100644
--- a/src/Simplex/Chat/Protocol.hs
+++ b/src/Simplex/Chat/Protocol.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
@@ -11,6 +10,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
@@ -23,6 +23,7 @@ import Data.Aeson (FromJSON, ToJSON, (.:), (.:?), (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.KeyMap as JM
+import qualified Data.Aeson.TH as JQ
 import qualified Data.Aeson.Types as JT
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
@@ -40,13 +41,12 @@ import Data.Typeable (Typeable)
 import Data.Word (Word32)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
 import Simplex.Chat.Call
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Util
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
 import Simplex.Messaging.Version hiding (version)
 
@@ -70,14 +70,9 @@ data ConnectionEntity
   | SndFileConnection {entityConnection :: Connection, sndFileTransfer :: SndFileTransfer}
   | RcvFileConnection {entityConnection :: Connection, rcvFileTransfer :: RcvFileTransfer}
   | UserContactConnection {entityConnection :: Connection, userContact :: UserContact}
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
-instance FromJSON ConnectionEntity where
-  parseJSON = J.genericParseJSON $ sumTypeJSON fstToLower
-
-instance ToJSON ConnectionEntity where
-  toJSON = J.genericToJSON $ sumTypeJSON fstToLower
-  toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
+$(JQ.deriveJSON (sumTypeJSON fstToLower) ''ConnectionEntity)
 
 updateEntityConnStatus :: ConnectionEntity -> ConnStatus -> ConnectionEntity
 updateEntityConnStatus connEntity connStatus = case connEntity of
@@ -104,8 +99,6 @@ instance MsgEncodingI 'Binary where encoding = SBinary
 
 instance MsgEncodingI 'Json where encoding = SJson
 
-data ACMEventTag = forall e. MsgEncodingI e => ACMEventTag (SMsgEncoding e) (CMEventTag e)
-
 instance TestEquality SMsgEncoding where
   testEquality SBinary SBinary = Just Refl
   testEquality SJson SJson = Just Refl
@@ -127,7 +120,6 @@ data AppMessageJson = AppMessageJson
     event :: Text,
     params :: J.Object
   }
-  deriving (Generic, FromJSON)
 
 data AppMessageBinary = AppMessageBinary
   { msgId :: Maybe SharedMsgId,
@@ -135,10 +127,6 @@ data AppMessageBinary = AppMessageBinary
     body :: ByteString
   }
 
-instance ToJSON AppMessageJson where
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-
 instance StrEncoding AppMessageBinary where
   strEncode AppMessageBinary {tag, msgId, body} = smpEncode (tag, msgId', Tail body)
     where
@@ -167,20 +155,42 @@ instance ToJSON SharedMsgId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
+$(JQ.deriveJSON defaultJSON ''AppMessageJson)
+
 data MsgRef = MsgRef
   { msgId :: Maybe SharedMsgId,
     sentAt :: UTCTime,
     sent :: Bool,
     memberId :: Maybe MemberId -- must be present in all group message references, both referencing sent and received
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
-instance FromJSON MsgRef where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
+$(JQ.deriveJSON defaultJSON ''MsgRef)
 
-instance ToJSON MsgRef where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData, content :: Maybe LinkContent}
+  deriving (Eq, Show)
+
+data LinkContent = LCPage | LCImage | LCVideo {duration :: Maybe Int} | LCUnknown {tag :: Text, json :: J.Object}
+  deriving (Eq, Show)
+
+$(pure [])
+
+instance FromJSON LinkContent where
+  parseJSON v@(J.Object j) =
+    $(JQ.mkParseJSON (taggedObjectJSON $ dropPrefix "LC") ''LinkContent) v
+      <|> LCUnknown <$> j .: "type" <*> pure j
+  parseJSON invalid =
+    JT.prependFailure "bad LinkContent, " (JT.typeMismatch "Object" invalid)
+
+instance ToJSON LinkContent where
+  toJSON = \case
+    LCUnknown _ j -> J.Object j
+    v -> $(JQ.mkToJSON (taggedObjectJSON $ dropPrefix "LC") ''LinkContent) v
+  toEncoding = \case
+    LCUnknown _ j -> JE.value $ J.Object j
+    v -> $(JQ.mkToEncoding (taggedObjectJSON $ dropPrefix "LC") ''LinkContent) v
+
+$(JQ.deriveJSON defaultJSON ''LinkPreview)
 
 data ChatMessage e = ChatMessage
   { chatVRange :: VersionRange,
@@ -191,19 +201,6 @@ data ChatMessage e = ChatMessage
 
 data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMessage e)
 
-instance MsgEncodingI e => StrEncoding (ChatMessage e) where
-  strEncode msg = case chatToAppMessage msg of
-    AMJson m -> LB.toStrict $ J.encode m
-    AMBinary m -> strEncode m
-  strP = (\(ACMsg _ m) -> checkEncoding m) <$?> strP
-
-instance StrEncoding AChatMessage where
-  strEncode (ACMsg _ m) = strEncode m
-  strP =
-    A.peekChar' >>= \case
-      '{' -> ACMsg SJson <$> ((appJsonToCM <=< J.eitherDecodeStrict') <$?> A.takeByteString)
-      _ -> ACMsg SBinary <$> (appBinaryToCM <$?> strP)
-
 data ChatMsgEvent (e :: MsgEncoding) where
   XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
   XMsgFileDescr :: {msgId :: SharedMsgId, fileDescr :: FileDescr} -> ChatMsgEvent 'Json
@@ -329,11 +326,7 @@ instance Encoding InlineFileChunk where
         pure FileChunk {chunkNo = fromIntegral $ c2w c, chunkBytes}
 
 data QuotedMsg = QuotedMsg {msgRef :: MsgRef, content :: MsgContent}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON QuotedMsg where
-  toEncoding = J.genericToEncoding J.defaultOptions
-  toJSON = J.genericToJSON J.defaultOptions
+  deriving (Eq, Show)
 
 cmToQuotedMsg :: AChatMsgEvent -> Maybe QuotedMsg
 cmToQuotedMsg = \case
@@ -386,34 +379,6 @@ isQuote = \case
   MCQuote {} -> True
   _ -> False
 
-data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData, content :: Maybe LinkContent}
-  deriving (Eq, Show, Generic)
-
-data LinkContent = LCPage | LCImage | LCVideo {duration :: Maybe Int} | LCUnknown {tag :: Text, json :: J.Object}
-  deriving (Eq, Show, Generic)
-
-instance FromJSON LinkPreview where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
-
-instance ToJSON LinkPreview where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
-instance FromJSON LinkContent where
-  parseJSON v@(J.Object j) =
-    J.genericParseJSON (taggedObjectJSON $ dropPrefix "LC") v
-      <|> LCUnknown <$> j .: "type" <*> pure j
-  parseJSON invalid =
-    JT.prependFailure "bad LinkContent, " (JT.typeMismatch "Object" invalid)
-
-instance ToJSON LinkContent where
-  toJSON = \case
-    LCUnknown _ j -> J.Object j
-    v -> J.genericToJSON (taggedObjectJSON $ dropPrefix "LC") v
-  toEncoding = \case
-    LCUnknown _ j -> JE.value $ J.Object j
-    v -> J.genericToEncoding (taggedObjectJSON $ dropPrefix "LC") v
-
 data MsgContent
   = MCText Text
   | MCLink {text :: Text, preview :: LinkPreview}
@@ -466,6 +431,21 @@ msgContentTag = \case
 data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInvitation, ttl :: Maybe Int, live :: Maybe Bool}
   deriving (Eq, Show)
 
+$(JQ.deriveJSON defaultJSON ''QuotedMsg)
+
+instance MsgEncodingI e => StrEncoding (ChatMessage e) where
+  strEncode msg = case chatToAppMessage msg of
+    AMJson m -> LB.toStrict $ J.encode m
+    AMBinary m -> strEncode m
+  strP = (\(ACMsg _ m) -> checkEncoding m) <$?> strP
+
+instance StrEncoding AChatMessage where
+  strEncode (ACMsg _ m) = strEncode m
+  strP =
+    A.peekChar' >>= \case
+      '{' -> ACMsg SJson <$> ((appJsonToCM <=< J.eitherDecodeStrict') <$?> A.takeByteString)
+      _ -> ACMsg SBinary <$> (appBinaryToCM <$?> strP)
+
 parseMsgContainer :: J.Object -> JT.Parser MsgContainer
 parseMsgContainer v =
   MCQuote <$> v .: "quote" <*> mc
@@ -545,6 +525,8 @@ instance ToField MsgContent where
 instance FromField MsgContent where
   fromField = fromTextField_ decodeJSON
 
+data ACMEventTag = forall e. MsgEncodingI e => ACMEventTag (SMsgEncoding e) (CMEventTag e)
+
 data CMEventTag (e :: MsgEncoding) where
   XMsgNew_ :: CMEventTag 'Json
   XMsgFileDescr_ :: CMEventTag 'Json
diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs
index 65a851f71..aa4ebe595 100644
--- a/src/Simplex/Chat/Remote/Protocol.hs
+++ b/src/Simplex/Chat/Remote/Protocol.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index de54813a4..d16955199 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -12,7 +11,7 @@ import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
 import UnliftIO
 
 data RemoteHostClient = RemoteHostClient
@@ -116,10 +115,10 @@ $(J.deriveJSON (sumTypeJSON $ dropPrefix "RPE") ''RemoteProtocolError)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "PE") ''PlatformEncoding)
 
-$(J.deriveJSON J.defaultOptions ''RemoteCtrlOOB)
+$(J.deriveJSON defaultJSON ''RemoteCtrlOOB)
 
-$(J.deriveJSON J.defaultOptions ''RemoteHostInfo)
+$(J.deriveJSON defaultJSON ''RemoteHostInfo)
 
-$(J.deriveJSON J.defaultOptions {J.omitNothingFields = True} ''RemoteCtrl)
+$(J.deriveJSON defaultJSON ''RemoteCtrl)
 
-$(J.deriveJSON J.defaultOptions {J.omitNothingFields = True} ''RemoteCtrlInfo)
+$(J.deriveJSON defaultJSON ''RemoteCtrlInfo)
diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs
index d4ca3193b..99689b29d 100644
--- a/src/Simplex/Chat/Store/Profiles.hs
+++ b/src/Simplex/Chat/Store/Profiles.hs
@@ -1,10 +1,10 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -61,8 +61,7 @@ where
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
-import Data.Aeson (FromJSON, ToJSON)
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import Data.Functor (($>))
 import Data.Int (Int64)
 import qualified Data.List.NonEmpty as L
@@ -73,7 +72,6 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
 import Database.SQLite.Simple (NamedParam (..), Only (..), (:.) (..))
 import Database.SQLite.Simple.QQ (sql)
-import GHC.Generics (Generic)
 import Simplex.Chat.Call
 import Simplex.Chat.Messages
 import Simplex.Chat.Protocol
@@ -86,6 +84,7 @@ import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode)
 import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util (safeDecodeUtf8)
@@ -400,17 +399,17 @@ data UserContactLink = UserContactLink
   { connReqContact :: ConnReqContact,
     autoAccept :: Maybe AutoAccept
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON UserContactLink where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data AutoAccept = AutoAccept
   { acceptIncognito :: IncognitoEnabled,
     autoReply :: Maybe MsgContent
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show)
 
-instance ToJSON AutoAccept where toEncoding = J.genericToEncoding J.defaultOptions
+$(J.deriveJSON defaultJSON ''AutoAccept)
+
+$(J.deriveJSON defaultJSON ''UserContactLink)
 
 toUserContactLink :: (ConnReqContact, Bool, IncognitoEnabled, Maybe MsgContent) -> UserContactLink
 toUserContactLink (connReq, autoAccept, acceptIncognito, autoReply) =
diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs
index d00dce718..7c1f07191 100644
--- a/src/Simplex/Chat/Store/Shared.hs
+++ b/src/Simplex/Chat/Store/Shared.hs
@@ -1,11 +1,11 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeOperators #-}
 
 module Simplex.Chat.Store.Shared where
@@ -16,8 +16,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Crypto.Random (ChaChaDRG, randomBytesGenerate)
-import Data.Aeson (FromJSON, ToJSON)
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
@@ -28,7 +27,6 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime)
 import Database.SQLite.Simple (NamedParam (..), Only (..), Query, SQLError, (:.) (..))
 import qualified Database.SQLite.Simple as SQL
 import Database.SQLite.Simple.QQ (sql)
-import GHC.Generics (Generic)
 import Simplex.Chat.Messages
 import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.Types
@@ -103,14 +101,9 @@ data StoreError
   | SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId}
   | SERemoteHostNotFound {remoteHostId :: RemoteHostId}
   | SERemoteCtrlNotFound {remoteCtrlId :: RemoteCtrlId}
-  deriving (Show, Exception, Generic)
+  deriving (Show, Exception)
 
-instance FromJSON StoreError where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SE"
-
-instance ToJSON StoreError where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SE"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SE"
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "SE") ''StoreError)
 
 insertedRowId :: DB.Connection -> IO Int64
 insertedRowId db = fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index b3c4ea09b..057067d85 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -45,14 +44,13 @@ import Database.SQLite.Simple.FromField (returnError, FromField(..))
 import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Util
 import Simplex.FileTransfer.Description (FileDigest)
 import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, SAEntity (..), UserId)
 import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON, taggedObjectJSON, enumJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, sumTypeJSON, taggedObjectJSON, enumJSON)
 import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI)
 import Simplex.Messaging.Util ((<$?>))
 import Simplex.Messaging.Version
@@ -264,9 +262,7 @@ data UserContact = UserContact
     connReqContact :: ConnReqContact,
     groupId :: Maybe GroupId
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON UserContact where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 userContactGroupId :: UserContact -> Maybe GroupId
 userContactGroupId UserContact {groupId} = groupId
@@ -284,10 +280,7 @@ data UserContactRequest = UserContactRequest
     updatedAt :: UTCTime,
     xContactId :: Maybe XContactId
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON UserContactRequest where
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 newtype XContactId = XContactId ByteString
   deriving (Eq, Show)
@@ -341,9 +334,7 @@ optionalFullName displayName fullName
   | otherwise = " (" <> fullName <> ")"
 
 data Group = Group {groupInfo :: GroupInfo, members :: [GroupMember]}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON Group where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 type GroupId = Int64
 
@@ -359,9 +350,7 @@ data GroupInfo = GroupInfo
     updatedAt :: UTCTime,
     chatTs :: Maybe UTCTime
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON GroupInfo where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 groupName' :: GroupInfo -> GroupName
 groupName' GroupInfo {localDisplayName = g} = g
@@ -369,9 +358,7 @@ groupName' GroupInfo {localDisplayName = g} = g
 data GroupSummary = GroupSummary
   { currentMembers :: Int
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON GroupSummary where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 data ContactOrGroup = CGContact Contact | CGGroup Group
 
@@ -386,9 +373,7 @@ data ChatSettings = ChatSettings
     sendRcpts :: Maybe Bool,
     favorite :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON ChatSettings where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 defaultChatSettings :: ChatSettings
 defaultChatSettings =
@@ -402,18 +387,7 @@ chatHasNtfs :: ChatSettings -> Bool
 chatHasNtfs ChatSettings {enableNtfs} = enableNtfs /= MFNone
 
 data MsgFilter = MFNone | MFAll | MFMentions
-  deriving (Eq, Show, Generic)
-
-instance FromJSON MsgFilter where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MF"
-
-instance ToJSON MsgFilter where
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MF"
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "MF"
-
-instance FromField MsgFilter where fromField = fromIntField_ msgFilterIntP
-
-instance ToField MsgFilter where toField = toField . msgFilterInt
+  deriving (Eq, Show)
 
 msgFilterInt :: MsgFilter -> Int
 msgFilterInt = \case
@@ -496,11 +470,7 @@ data Profile = Profile
     -- - incognito
     -- - local_alias
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON Profile where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 -- check if profiles match ignoring preferences
 profilesMatch :: LocalProfile -> LocalProfile -> Bool
@@ -522,11 +492,7 @@ data LocalProfile = LocalProfile
     preferences :: Maybe Preferences,
     localAlias :: LocalAlias
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON LocalProfile where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 localProfileId :: LocalProfile -> ProfileId
 localProfileId LocalProfile{profileId} = profileId
@@ -546,11 +512,7 @@ data GroupProfile = GroupProfile
     image :: Maybe ImageData,
     groupPreferences :: Maybe GroupPreferences
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON GroupProfile where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 newtype ImageData = ImageData Text
   deriving (Eq, Show)
@@ -567,14 +529,6 @@ instance ToField ImageData where toField (ImageData t) = toField t
 instance FromField ImageData where fromField = fmap ImageData . fromField
 
 data CReqClientData = CRDataGroup {groupLinkId :: GroupLinkId}
-  deriving (Generic)
-
-instance ToJSON CReqClientData where
-  toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "CRData"
-  toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "CRData"
-
-instance FromJSON CReqClientData where
-  parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "CRData"
 
 newtype GroupLinkId = GroupLinkId {unGroupLinkId :: ByteString} -- used to identify invitation via group link
   deriving (Eq, Show)
@@ -602,29 +556,19 @@ data GroupInvitation = GroupInvitation
     groupProfile :: GroupProfile,
     groupLinkId :: Maybe GroupLinkId
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON GroupInvitation where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 data MemberIdRole = MemberIdRole
   { memberId :: MemberId,
     memberRole :: GroupMemberRole
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON MemberIdRole where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data IntroInvitation = IntroInvitation
   { groupConnReq :: ConnReqInvitation,
     directConnReq :: Maybe ConnReqInvitation
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON IntroInvitation where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 data MemberInfo = MemberInfo
   { memberId :: MemberId,
@@ -632,11 +576,7 @@ data MemberInfo = MemberInfo
     v :: Maybe ChatVersionRange,
     profile :: Profile
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON MemberInfo where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 memberInfo :: GroupMember -> MemberInfo
 memberInfo GroupMember {memberId, memberRole, memberProfile, activeConn} =
@@ -675,16 +615,10 @@ data GroupMember = GroupMember
     memberContactProfileId :: ProfileId,
     activeConn :: Maybe Connection
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON GroupMember where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 data GroupMemberRef = GroupMemberRef {groupMemberId :: Int64, profile :: Profile}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON GroupMemberRef where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 groupMemberRef :: GroupMember -> GroupMemberRef
 groupMemberRef GroupMember {groupMemberId, memberProfile = p} =
@@ -744,14 +678,7 @@ instance ToJSON MemberId where
   toEncoding = strToJEncoding
 
 data InvitedBy = IBContact {byContactId :: Int64} | IBUser | IBUnknown
-  deriving (Eq, Show, Generic)
-
-instance FromJSON InvitedBy where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "IB"
-
-instance ToJSON InvitedBy where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "IB"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "IB"
+  deriving (Eq, Show)
 
 toInvitedBy :: Int64 -> Maybe Int64 -> InvitedBy
 toInvitedBy userCtId (Just ctId)
@@ -803,9 +730,7 @@ instance ToJSON GroupMemberRole where
 data GroupMemberSettings = GroupMemberSettings
   { showMessages :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON GroupMemberSettings where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 defaultMemberSettings :: GroupMemberSettings
 defaultMemberSettings = GroupMemberSettings {showMessages = True}
@@ -986,9 +911,7 @@ data SndFileTransfer = SndFileTransfer
     fileDescrId :: Maybe Int64,
     fileInline :: Maybe InlineFileMode
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON SndFileTransfer where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 sndFileTransferConnId :: SndFileTransfer -> ConnId
 sndFileTransferConnId SndFileTransfer {agentConnId = AgentConnId acId} = acId
@@ -1003,24 +926,10 @@ data FileInvitation = FileInvitation
     fileInline :: Maybe InlineFileMode,
     fileDescr :: Maybe FileDescr
   }
-  deriving (Eq, Show, Generic)
-
-instance ToJSON FileInvitation where
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-
-instance FromJSON FileInvitation where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 data FileDescr = FileDescr {fileDescrText :: Text, fileDescrPartNo :: Int, fileDescrComplete :: Bool}
-  deriving (Eq, Show, Generic)
-
-instance ToJSON FileDescr where
-  toEncoding = J.genericToEncoding J.defaultOptions
-  toJSON = J.genericToJSON J.defaultOptions
-
-instance FromJSON FileDescr where
-  parseJSON = J.genericParseJSON J.defaultOptions
+  deriving (Eq, Show)
 
 xftpFileInvitation :: FilePath -> Integer -> FileDescr -> FileInvitation
 xftpFileInvitation fileName fileSize fileDescr =
@@ -1036,7 +945,7 @@ xftpFileInvitation fileName fileSize fileDescr =
 data InlineFileMode
   = IFMOffer -- file will be sent inline once accepted
   | IFMSent -- file is sent inline without acceptance
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 instance TextEncoding InlineFileMode where
   textEncode = \case
@@ -1072,18 +981,14 @@ data RcvFileTransfer = RcvFileTransfer
     -- SMP files are encrypted after all chunks are received
     cryptoArgs :: Maybe CryptoFileArgs
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON RcvFileTransfer where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data XFTPRcvFile = XFTPRcvFile
   { rcvFileDescription :: RcvFileDescr,
     agentRcvFileId :: Maybe AgentRcvFileId,
     agentRcvFileDeleted :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON XFTPRcvFile where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data RcvFileDescr = RcvFileDescr
   { fileDescrId :: Int64,
@@ -1091,9 +996,7 @@ data RcvFileDescr = RcvFileDescr
     fileDescrPartNo :: Int,
     fileDescrComplete :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON RcvFileDescr where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data RcvFileStatus
   = RFSNew
@@ -1101,14 +1004,7 @@ data RcvFileStatus
   | RFSConnected RcvFileInfo
   | RFSComplete RcvFileInfo
   | RFSCancelled (Maybe RcvFileInfo)
-  deriving (Eq, Show, Generic)
-
-instance FromJSON RcvFileStatus where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RFS"
-
-instance ToJSON RcvFileStatus where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RFS"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RFS"
+  deriving (Eq, Show)
 
 rcvFileComplete :: RcvFileStatus -> Bool
 rcvFileComplete = \case
@@ -1123,9 +1019,7 @@ data RcvFileInfo = RcvFileInfo
     connId :: Maybe Int64,
     agentConnId :: Maybe AgentConnId
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON RcvFileInfo where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 liveRcvFileTransferInfo :: RcvFileTransfer -> Maybe RcvFileInfo
 liveRcvFileTransferInfo RcvFileTransfer {fileStatus} = case fileStatus of
@@ -1226,14 +1120,7 @@ data FileTransfer
         sndFileTransfers :: [SndFileTransfer]
       }
   | FTRcv {rcvFileTransfer :: RcvFileTransfer}
-  deriving (Show, Generic)
-
-instance FromJSON FileTransfer where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "FT"
-
-instance ToJSON FileTransfer where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "FT"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "FT"
+  deriving (Show)
 
 data FileTransferMeta = FileTransferMeta
   { fileId :: FileTransferId,
@@ -1245,9 +1132,7 @@ data FileTransferMeta = FileTransferMeta
     chunkSize :: Integer,
     cancelled :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON FileTransferMeta where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data XFTPSndFile = XFTPSndFile
   { agentSndFileId :: AgentSndFileId,
@@ -1255,9 +1140,7 @@ data XFTPSndFile = XFTPSndFile
     agentSndFileDeleted :: Bool,
     cryptoArgs :: Maybe CryptoFileArgs
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON XFTPSndFile where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 fileTransferCancelled :: FileTransfer -> Bool
 fileTransferCancelled (FTSnd FileTransferMeta {cancelled} _) = cancelled
@@ -1318,7 +1201,7 @@ data Connection = Connection
     authErrCounter :: Int,
     createdAt :: UTCTime
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 connReady :: Connection -> Bool
 connReady Connection {connStatus} = connStatus == ConnReady || connStatus == ConnSndReady
@@ -1330,9 +1213,7 @@ connDisabled :: Connection -> Bool
 connDisabled Connection {authErrCounter} = authErrCounter >= authErrDisableCount
 
 data SecurityCode = SecurityCode {securityCode :: Text, verifiedAt :: UTCTime}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON SecurityCode where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 verificationCode :: ByteString -> Text
 verificationCode = T.pack . unwords . chunks 5 . show . os2ip
@@ -1351,13 +1232,6 @@ aConnId Connection {agentConnId = AgentConnId cId} = cId
 connIncognito :: Connection -> Bool
 connIncognito Connection {customUserProfileId} = isJust customUserProfileId
 
-instance FromJSON Connection where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
-
-instance ToJSON Connection where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
 data PendingContactConnection = PendingContactConnection
   { pccConnId :: Int64,
     pccAgentConnId :: AgentConnId,
@@ -1371,13 +1245,11 @@ data PendingContactConnection = PendingContactConnection
     createdAt :: UTCTime,
     updatedAt :: UTCTime
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 aConnId' :: PendingContactConnection -> ConnId
 aConnId' PendingContactConnection {pccAgentConnId = AgentConnId cId} = cId
 
-instance ToJSON PendingContactConnection where toEncoding = J.genericToEncoding J.defaultOptions
-
 data ConnStatus
   = -- | connection is created by initiating party with agent NEW command (createConnection)
     ConnNew
@@ -1512,7 +1384,7 @@ data NetworkStatus
   | NSConnected
   | NSDisconnected
   | NSError {connectionError :: String}
-  deriving (Eq, Ord, Show, Generic)
+  deriving (Eq, Ord, Show)
 
 netStatusStr :: NetworkStatus -> String
 netStatusStr = \case
@@ -1521,20 +1393,11 @@ netStatusStr = \case
   NSDisconnected -> "disconnected"
   NSError e -> "error: " <> e
 
-instance FromJSON NetworkStatus where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "NS"
-
-instance ToJSON NetworkStatus where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "NS"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "NS"
-
 data ConnNetworkStatus = ConnNetworkStatus
   { agentConnId :: AgentConnId,
     networkStatus :: NetworkStatus
   }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON ConnNetworkStatus where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Show)
 
 type CommandId = Int64
 
@@ -1548,7 +1411,7 @@ data CommandStatus
   = CSCreated
   | CSCompleted -- unused - was replaced with deleteCommand
   | CSError -- internal command error, e.g. not matching connection id or unexpected response, not related to agent message ERR
-  deriving (Show, Generic)
+  deriving (Show)
 
 instance FromField CommandStatus where fromField = fromTextField_ textDecode
 
@@ -1575,7 +1438,7 @@ data CommandFunction
   | CFAcceptContact
   | CFAckMessage
   | CFDeleteConn -- not used
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 instance FromField CommandFunction where fromField = fromTextField_ textDecode
 
@@ -1641,14 +1504,7 @@ data ServerCfg p = ServerCfg
     tested :: Maybe Bool,
     enabled :: Bool
   }
-  deriving (Show, Generic)
-
-instance ProtocolTypeI p => ToJSON (ServerCfg p) where
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-
-instance ProtocolTypeI p => FromJSON (ServerCfg p) where
-  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
+  deriving (Show)
 
 newtype ChatVersionRange = ChatVersionRange {fromChatVRange :: VersionRange} deriving (Eq, Show)
 
@@ -1674,14 +1530,95 @@ instance ToJSON JVersionRange where
   toJSON (JVersionRange (VersionRange minV maxV)) = J.object ["minVersion" .= minV, "maxVersion" .= maxV]
   toEncoding (JVersionRange (VersionRange minV maxV)) = J.pairs $ "minVersion" .= minV <> "maxVersion" .= maxV
 
-$(JQ.deriveJSON defOpts ''UserPwdHash)
+$(JQ.deriveJSON defaultJSON ''UserContact)
 
-$(JQ.deriveJSON defOpts ''User)
+$(JQ.deriveJSON defaultJSON ''Profile)
 
-$(JQ.deriveJSON defOpts ''NewUser)
+$(JQ.deriveJSON defaultJSON ''LocalProfile)
 
-$(JQ.deriveJSON defOpts ''UserInfo)
+$(JQ.deriveJSON defaultJSON ''UserContactRequest)
 
-$(JQ.deriveJSON defOpts ''Contact)
+$(JQ.deriveJSON defaultJSON ''GroupProfile)
 
-$(JQ.deriveJSON defOpts ''ContactRef)
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "IB") ''InvitedBy)
+
+$(JQ.deriveJSON defaultJSON ''GroupMemberSettings)
+
+$(JQ.deriveJSON defaultJSON ''SecurityCode)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "NS") ''NetworkStatus)
+
+$(JQ.deriveJSON defaultJSON ''ConnNetworkStatus)
+
+$(JQ.deriveJSON defaultJSON ''Connection)
+
+$(JQ.deriveJSON defaultJSON ''PendingContactConnection)
+
+$(JQ.deriveJSON defaultJSON ''GroupMember)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "MF") ''MsgFilter)
+
+$(JQ.deriveJSON defaultJSON ''ChatSettings)
+
+$(JQ.deriveJSON defaultJSON ''GroupInfo)
+
+$(JQ.deriveJSON defaultJSON ''Group)
+
+$(JQ.deriveJSON defaultJSON ''GroupSummary)
+
+instance FromField MsgFilter where fromField = fromIntField_ msgFilterIntP
+
+instance ToField MsgFilter where toField = toField . msgFilterInt
+
+$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "CRData") ''CReqClientData)
+
+$(JQ.deriveJSON defaultJSON ''MemberIdRole)
+
+$(JQ.deriveJSON defaultJSON ''GroupInvitation)
+
+$(JQ.deriveJSON defaultJSON ''IntroInvitation)
+
+$(JQ.deriveJSON defaultJSON ''MemberInfo)
+
+$(JQ.deriveJSON defaultJSON ''GroupMemberRef)
+
+$(JQ.deriveJSON defaultJSON ''FileDescr)
+
+$(JQ.deriveJSON defaultJSON ''FileInvitation)
+
+$(JQ.deriveJSON defaultJSON ''SndFileTransfer)
+
+$(JQ.deriveJSON defaultJSON ''RcvFileDescr)
+
+$(JQ.deriveJSON defaultJSON ''XFTPRcvFile)
+
+$(JQ.deriveJSON defaultJSON ''RcvFileInfo)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RFS") ''RcvFileStatus)
+
+$(JQ.deriveJSON defaultJSON ''RcvFileTransfer)
+
+$(JQ.deriveJSON defaultJSON ''XFTPSndFile)
+
+$(JQ.deriveJSON defaultJSON ''FileTransferMeta)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "FT") ''FileTransfer)
+
+$(JQ.deriveJSON defaultJSON ''UserPwdHash)
+
+$(JQ.deriveJSON defaultJSON ''User)
+
+$(JQ.deriveJSON defaultJSON ''NewUser)
+
+$(JQ.deriveJSON defaultJSON ''UserInfo)
+
+$(JQ.deriveJSON defaultJSON ''Contact)
+
+$(JQ.deriveJSON defaultJSON ''ContactRef)
+
+instance ProtocolTypeI p => ToJSON (ServerCfg p) where
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerCfg)
+  toJSON = $(JQ.mkToJSON defaultJSON ''ServerCfg)
+
+instance ProtocolTypeI p => FromJSON (ServerCfg p) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''ServerCfg)
diff --git a/src/Simplex/Chat/Types/Preferences.hs b/src/Simplex/Chat/Types/Preferences.hs
index c7555e18a..da13da742 100644
--- a/src/Simplex/Chat/Types/Preferences.hs
+++ b/src/Simplex/Chat/Types/Preferences.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -12,6 +11,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
 
@@ -24,7 +24,7 @@ module Simplex.Chat.Types.Preferences where
 
 import Control.Applicative ((<|>))
 import Data.Aeson (FromJSON (..), ToJSON (..))
-import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import Data.Maybe (fromMaybe, isJust)
@@ -32,11 +32,10 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import GHC.Generics (Generic)
 import GHC.Records.Compat
 import Simplex.Chat.Types.Util
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON)
 import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
 
 data ChatFeature
@@ -45,7 +44,7 @@ data ChatFeature
   | CFReactions
   | CFVoice
   | CFCalls
-  deriving (Show, Generic)
+  deriving (Show)
 
 data SChatFeature (f :: ChatFeature) where
   SCFTimedMessages :: SChatFeature 'CFTimedMessages
@@ -71,13 +70,6 @@ chatFeatureNameText = \case
 chatFeatureNameText' :: SChatFeature f -> Text
 chatFeatureNameText' = chatFeatureNameText . chatFeature
 
-instance ToJSON ChatFeature where
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CF"
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CF"
-
-instance FromJSON ChatFeature where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CF"
-
 allChatFeatures :: [AChatFeature]
 allChatFeatures =
   [ ACF SCFTimedMessages,
@@ -149,17 +141,7 @@ data Preferences = Preferences
     voice :: Maybe VoicePreference,
     calls :: Maybe CallsPreference
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON Preferences where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
-instance ToField Preferences where
-  toField = toField . encodeJSON
-
-instance FromField Preferences where
-  fromField = fromTextField_ decodeJSON
+  deriving (Eq, Show)
 
 data GroupFeature
   = GFTimedMessages
@@ -168,7 +150,7 @@ data GroupFeature
   | GFReactions
   | GFVoice
   | GFFiles
-  deriving (Show, Generic)
+  deriving (Show)
 
 data SGroupFeature (f :: GroupFeature) where
   SGFTimedMessages :: SGroupFeature 'GFTimedMessages
@@ -200,13 +182,6 @@ groupFeatureAllowed' :: GroupFeatureI f => SGroupFeature f -> FullGroupPreferenc
 groupFeatureAllowed' feature prefs =
   getField @"enable" (getGroupPreference feature prefs) == FEOn
 
-instance ToJSON GroupFeature where
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "GF"
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "GF"
-
-instance FromJSON GroupFeature where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "GF"
-
 allGroupFeatures :: [AGroupFeature]
 allGroupFeatures =
   [ AGF SGFTimedMessages,
@@ -263,17 +238,7 @@ data GroupPreferences = GroupPreferences
     voice :: Maybe VoiceGroupPreference,
     files :: Maybe FilesGroupPreference
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON GroupPreferences where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
-instance ToField GroupPreferences where
-  toField = toField . encodeJSON
-
-instance FromField GroupPreferences where
-  fromField = fromTextField_ decodeJSON
+  deriving (Eq, Show)
 
 setGroupPreference :: forall f. GroupFeatureI f => SGroupFeature f -> GroupFeatureEnabled -> Maybe GroupPreferences -> GroupPreferences
 setGroupPreference f enable prefs_ = setGroupPreference_ f pref prefs
@@ -312,9 +277,7 @@ data FullPreferences = FullPreferences
     voice :: VoicePreference,
     calls :: CallsPreference
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON FullPreferences where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 -- full collection of group preferences defined in the app - it is used to ensure we include all preferences and to simplify processing
 -- if some of the preferences are not defined in GroupPreferences, defaults from defaultGroupPrefs are used here.
@@ -326,9 +289,7 @@ data FullGroupPreferences = FullGroupPreferences
     voice :: VoiceGroupPreference,
     files :: FilesGroupPreference
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON FullGroupPreferences where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 -- merged preferences of user for a given contact - they differentiate between specific preferences for the contact and global user preferences
 data ContactUserPreferences = ContactUserPreferences
@@ -338,30 +299,17 @@ data ContactUserPreferences = ContactUserPreferences
     voice :: ContactUserPreference VoicePreference,
     calls :: ContactUserPreference CallsPreference
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data ContactUserPreference p = ContactUserPreference
   { enabled :: PrefEnabled,
     userPreference :: ContactUserPref p,
     contactPreference :: p
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 data ContactUserPref p = CUPContact {preference :: p} | CUPUser {preference :: p}
-  deriving (Eq, Show, Generic)
-
-instance ToJSON ContactUserPreferences where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance FromJSON p => FromJSON (ContactUserPreference p) where parseJSON = J.genericParseJSON J.defaultOptions
-
-instance ToJSON p => ToJSON (ContactUserPreference p) where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance FromJSON p => FromJSON (ContactUserPref p) where
-  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CUP"
-
-instance ToJSON p => ToJSON (ContactUserPref p) where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CUP"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CUP"
+  deriving (Eq, Show)
 
 toChatPrefs :: FullPreferences -> Preferences
 toChatPrefs FullPreferences {timedMessages, fullDelete, reactions, voice, calls} =
@@ -404,31 +352,19 @@ data TimedMessagesPreference = TimedMessagesPreference
   { allow :: FeatureAllowed,
     ttl :: Maybe Int
   }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON TimedMessagesPreference where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  deriving (Eq, Show)
 
 data FullDeletePreference = FullDeletePreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON FullDeletePreference where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data ReactionsPreference = ReactionsPreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON ReactionsPreference where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data VoicePreference = VoicePreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON VoicePreference where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 data CallsPreference = CallsPreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON CallsPreference where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 class (Eq (FeaturePreference f), HasField "allow" (FeaturePreference f) FeatureAllowed) => FeatureI f where
   type FeaturePreference (f :: ChatFeature) = p | p -> f
@@ -477,47 +413,33 @@ instance FeatureI 'CFCalls where
 
 data GroupPreference = GroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data TimedMessagesGroupPreference = TimedMessagesGroupPreference
   { enable :: GroupFeatureEnabled,
     ttl :: Maybe Int
   }
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data DirectMessagesGroupPreference = DirectMessagesGroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data FullDeleteGroupPreference = FullDeleteGroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data ReactionsGroupPreference = ReactionsGroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data VoiceGroupPreference = VoiceGroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
+  deriving (Eq, Show)
 
 data FilesGroupPreference = FilesGroupPreference
   {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON GroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON TimedMessagesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON DirectMessagesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON ReactionsGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON FullDeleteGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON VoiceGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON FilesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference f) GroupFeatureEnabled) => GroupFeatureI f where
   type GroupFeaturePreference (f :: GroupFeature) = p | p -> f
@@ -619,7 +541,7 @@ data FeatureAllowed
   = FAAlways -- allow unconditionally
   | FAYes -- allow, if peer allows it
   | FANo -- do not allow
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 instance FromField FeatureAllowed where fromField = fromBlobField_ strDecode
 
@@ -645,7 +567,7 @@ instance ToJSON FeatureAllowed where
   toEncoding = strToJEncoding
 
 data GroupFeatureEnabled = FEOn | FEOff
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 instance FromField GroupFeatureEnabled where fromField = fromBlobField_ strDecode
 
@@ -718,11 +640,7 @@ toGroupPreferences groupPreferences =
     pref f = Just $ getGroupPreference f groupPreferences
 
 data PrefEnabled = PrefEnabled {forUser :: Bool, forContact :: Bool}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON PrefEnabled where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
+  deriving (Eq, Show)
 
 prefEnabled :: FeatureI f => Bool -> FeaturePreference f -> FeaturePreference f -> PrefEnabled
 prefEnabled asymmetric user contact = case (getField @"allow" user, getField @"allow" contact) of
@@ -784,3 +702,69 @@ getContactUserPreference f ps = case f of
   SCFReactions -> ps.reactions
   SCFVoice -> ps.voice
   SCFCalls -> ps.calls
+
+$(J.deriveJSON (enumJSON $ dropPrefix "CF") ''ChatFeature)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "GF") ''GroupFeature)
+
+$(J.deriveJSON defaultJSON ''TimedMessagesPreference)
+
+$(J.deriveJSON defaultJSON ''FullDeletePreference)
+
+$(J.deriveJSON defaultJSON ''ReactionsPreference)
+
+$(J.deriveJSON defaultJSON ''VoicePreference)
+
+$(J.deriveJSON defaultJSON ''CallsPreference)
+
+$(J.deriveJSON defaultJSON ''Preferences)
+
+instance ToField Preferences where
+  toField = toField . encodeJSON
+
+instance FromField Preferences where
+  fromField = fromTextField_ decodeJSON
+
+$(J.deriveJSON defaultJSON ''GroupPreference)
+
+$(J.deriveJSON defaultJSON ''TimedMessagesGroupPreference)
+
+$(J.deriveJSON defaultJSON ''DirectMessagesGroupPreference)
+
+$(J.deriveJSON defaultJSON ''ReactionsGroupPreference)
+
+$(J.deriveJSON defaultJSON ''FullDeleteGroupPreference)
+
+$(J.deriveJSON defaultJSON ''VoiceGroupPreference)
+
+$(J.deriveJSON defaultJSON ''FilesGroupPreference)
+
+$(J.deriveJSON defaultJSON ''GroupPreferences)
+
+instance ToField GroupPreferences where
+  toField = toField . encodeJSON
+
+instance FromField GroupPreferences where
+  fromField = fromTextField_ decodeJSON
+
+$(J.deriveJSON defaultJSON ''FullPreferences)
+
+$(J.deriveJSON defaultJSON ''FullGroupPreferences)
+
+$(J.deriveJSON defaultJSON ''PrefEnabled)
+
+instance FromJSON p => FromJSON (ContactUserPref p) where
+  parseJSON = $(J.mkParseJSON (sumTypeJSON $ dropPrefix "CUP") ''ContactUserPref)
+
+instance ToJSON p => ToJSON (ContactUserPref p) where
+  toJSON = $(J.mkToJSON (sumTypeJSON $ dropPrefix "CUP") ''ContactUserPref)
+  toEncoding = $(J.mkToEncoding (sumTypeJSON $ dropPrefix "CUP") ''ContactUserPref)
+
+instance FromJSON p => FromJSON (ContactUserPreference p) where
+  parseJSON = $(J.mkParseJSON defaultJSON ''ContactUserPreference)
+
+instance ToJSON p => ToJSON (ContactUserPreference p) where
+  toJSON = $(J.mkToJSON defaultJSON ''ContactUserPreference)
+  toEncoding = $(J.mkToEncoding defaultJSON ''ContactUserPreference)
+
+$(J.deriveJSON defaultJSON ''ContactUserPreferences)
diff --git a/src/Simplex/Chat/Types/Util.hs b/src/Simplex/Chat/Types/Util.hs
index 8681e9908..fffdd24b9 100644
--- a/src/Simplex/Chat/Types/Util.hs
+++ b/src/Simplex/Chat/Types/Util.hs
@@ -28,6 +28,3 @@ fromBlobField_ p = \case
       Right k -> Ok k
       Left e -> returnError ConversionFailed f ("could not parse field: " ++ e)
   f -> returnError ConversionFailed f "expecting SQLBlob column type"
-
-defOpts :: J.Options
-defOpts = J.defaultOptions {J.omitNothingFields = True}
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 501e232a6..2a3b74da3 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -7,12 +6,13 @@
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Simplex.Chat.View where
 
-import Data.Aeson (ToJSON)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (isSpace, toUpper)
@@ -31,7 +31,6 @@ import Data.Time (LocalTime (..), TimeOfDay (..), TimeZone (..), utcToLocalTime)
 import Data.Time.Calendar (addDays)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Format (defaultTimeLocale, formatTime)
-import GHC.Generics (Generic)
 import qualified Network.HTTP.Types as Q
 import Numeric (showFFloat)
 import Simplex.Chat (defaultChatConfig, maxImageSize)
@@ -66,6 +65,13 @@ import System.Console.ANSI.Types
 
 type CurrentTime = UTCTime
 
+data WCallCommand
+  = WCCallStart {media :: CallMedia, aesKey :: Maybe String, useWorker :: Bool}
+  | WCCallOffer {offer :: Text, iceCandidates :: Text, media :: CallMedia, aesKey :: Maybe String, useWorker :: Bool}
+  | WCCallAnswer {answer :: Text, iceCandidates :: Text}
+
+$(JQ.deriveToJSON (taggedObjectJSON $ dropPrefix "WCCall") ''WCallCommand)
+
 serializeChatResponse :: (Maybe RemoteHostId, Maybe User) -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> String
 serializeChatResponse user_ ts tz remoteHost_ = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz remoteHost_
 
@@ -1633,16 +1639,6 @@ supporedBrowsers callType
   | encryptedCall callType = " (only Chrome and Safari support e2e encryption for WebRTC, Safari may require enabling WebRTC insertable streams)"
   | otherwise = ""
 
-data WCallCommand
-  = WCCallStart {media :: CallMedia, aesKey :: Maybe String, useWorker :: Bool}
-  | WCCallOffer {offer :: Text, iceCandidates :: Text, media :: CallMedia, aesKey :: Maybe String, useWorker :: Bool}
-  | WCCallAnswer {answer :: Text, iceCandidates :: Text}
-  deriving (Generic)
-
-instance ToJSON WCallCommand where
-  toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "WCCall"
-  toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "WCCall"
-
 viewVersionInfo :: ChatLogLevel -> CoreVersionInfo -> [StyledString]
 viewVersionInfo logLevel CoreVersionInfo {version, simplexmqVersion, simplexmqCommit} =
   map plain $
diff --git a/stack.yaml b/stack.yaml
index f0fcbab1d..58a921303 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: d920a2504b6d4653748da7d297cb13cd0a0f1f48
+    commit: 511d793b927b1e2f12999e0829718671b3a8f0cb
   - github: kazu-yamamoto/http2
     commit: 804fa283f067bd3fd89b8c5f8d25b3047813a517
   # - ../direct-sqlcipher
diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs
index aa36b397a..d8e98513c 100644
--- a/tests/MobileTests.hs
+++ b/tests/MobileTests.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -9,8 +10,9 @@ module MobileTests where
 import ChatTests.Utils
 import Control.Monad.Except
 import Crypto.Random (getRandomBytes)
-import Data.Aeson (FromJSON (..))
+import Data.Aeson (FromJSON)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BS
@@ -256,9 +258,11 @@ testMediaCApi _ = do
       (f cKeyStr ptr cLen >>= peekCAString) `shouldReturn` ""
       getByteString ptr cLen
 
-instance FromJSON WriteFileResult where parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "WF"
+instance FromJSON WriteFileResult where
+  parseJSON = $(JQ.mkParseJSON (sumTypeJSON $ dropPrefix "WF") ''WriteFileResult)
 
-instance FromJSON ReadFileResult where parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RF"
+instance FromJSON ReadFileResult where
+  parseJSON = $(JQ.mkParseJSON (sumTypeJSON $ dropPrefix "RF") ''ReadFileResult)
 
 testFileCApi :: FilePath -> FilePath -> IO ()
 testFileCApi fileName tmp = do

From d90da57f1283e0c2f3ec18f9e9dfa77a8b1d4074 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 29 Oct 2023 19:06:32 +0000
Subject: [PATCH 24/69] core: store/get remote files (#3289)

* core: store remote files (wip)

* fix/test store remote file

* get remote file

* get file

* validate remote file metadata before sending to controller

* CLI commands, test

* update store method
---
 simplex-chat.cabal                   |   2 +
 src/Simplex/Chat.hs                  |  84 +++++-----
 src/Simplex/Chat/Archive.hs          |   1 +
 src/Simplex/Chat/Controller.hs       |  30 ++--
 src/Simplex/Chat/Files.hs            |  27 ++++
 src/Simplex/Chat/Messages.hs         |   5 +-
 src/Simplex/Chat/Mobile/File.hs      |   2 +-
 src/Simplex/Chat/Remote.hs           | 137 ++++++++++++----
 src/Simplex/Chat/Remote/Protocol.hs  | 107 ++++++-------
 src/Simplex/Chat/Remote/Transport.hs |  27 ++++
 src/Simplex/Chat/Remote/Types.hs     |  22 ++-
 src/Simplex/Chat/Store/Files.hs      |  53 ++++--
 src/Simplex/Chat/View.hs             |  43 +++--
 tests/RemoteTests.hs                 | 230 ++++++++++++++++++++-------
 14 files changed, 543 insertions(+), 227 deletions(-)
 create mode 100644 src/Simplex/Chat/Files.hs
 create mode 100644 src/Simplex/Chat/Remote/Transport.hs

diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index e9036ea60..f831bf540 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -32,6 +32,7 @@ library
       Simplex.Chat.Call
       Simplex.Chat.Controller
       Simplex.Chat.Core
+      Simplex.Chat.Files
       Simplex.Chat.Help
       Simplex.Chat.Markdown
       Simplex.Chat.Messages
@@ -131,6 +132,7 @@ library
       Simplex.Chat.Remote.Discovery
       Simplex.Chat.Remote.Multicast
       Simplex.Chat.Remote.Protocol
+      Simplex.Chat.Remote.Transport
       Simplex.Chat.Remote.Types
       Simplex.Chat.Store
       Simplex.Chat.Store.Connections
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index e8049dcbb..e46a426d8 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -55,6 +55,7 @@ import qualified Database.SQLite.Simple as SQL
 import Simplex.Chat.Archive
 import Simplex.Chat.Call
 import Simplex.Chat.Controller
+import Simplex.Chat.Files
 import Simplex.Chat.Markdown
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
@@ -104,7 +105,7 @@ import Simplex.Messaging.Transport.Client (defaultSocksProxy)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Exit (exitFailure, exitSuccess)
-import System.FilePath (combine, splitExtensions, takeFileName, (</>))
+import System.FilePath (takeFileName, (</>))
 import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, stdout)
 import System.Random (randomRIO)
 import Text.Read (readMaybe)
@@ -213,6 +214,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
   currentCalls <- atomically TM.empty
   localDeviceName <- newTVarIO "" -- TODO set in config
   remoteHostSessions <- atomically TM.empty
+  remoteHostsFolder <- newTVarIO Nothing
   remoteCtrlSession <- newTVarIO Nothing
   filesFolder <- newTVarIO optFilesFolder
   chatStoreChanged <- newTVarIO False
@@ -246,6 +248,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
         currentCalls,
         localDeviceName,
         remoteHostSessions,
+        remoteHostsFolder,
         remoteCtrlSession,
         config,
         filesFolder,
@@ -394,7 +397,7 @@ execChatCommand rh s = do
   case parseChatCommand s of
     Left e -> pure $ chatCmdError u e
     Right cmd -> case rh of
-      Just remoteHostId | allowRemoteCommand cmd -> execRemoteCommand u remoteHostId s
+      Just remoteHostId | allowRemoteCommand cmd -> execRemoteCommand u remoteHostId cmd s
       _ -> execChatCommand_ u cmd
 
 execChatCommand' :: ChatMonad' m => ChatCommand -> m ChatResponse
@@ -403,8 +406,8 @@ execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` c
 execChatCommand_ :: ChatMonad' m => Maybe User -> ChatCommand -> m ChatResponse
 execChatCommand_ u cmd = handleCommandError u $ processChatCommand cmd
 
-execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> ByteString -> m ChatResponse
-execRemoteCommand u rhId s = handleCommandError u $ getRemoteHostSession rhId >>= \rh -> processRemoteCommand rhId rh s
+execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> ChatCommand -> ByteString -> m ChatResponse
+execRemoteCommand u rhId cmd s = handleCommandError u $ getRemoteHostSession rhId >>= \rh -> processRemoteCommand rhId rh cmd s
 
 handleCommandError :: ChatMonad' m => Maybe User -> ExceptT ChatError m ChatResponse -> m ChatResponse
 handleCommandError u a = either (CRChatCmdError u) id <$> (runExceptT a `E.catch` (pure . Left . mkChatError))
@@ -542,6 +545,10 @@ processChatCommand = \case
     createDirectoryIfMissing True ff
     asks filesFolder >>= atomically . (`writeTVar` Just ff)
     ok_
+  SetRemoteHostsFolder rf -> do
+    createDirectoryIfMissing True rf
+    chatWriteVar remoteHostsFolder $ Just rf
+    ok_
   APISetXFTPConfig cfg -> do
     asks userXFTPFileConfig >>= atomically . (`writeTVar` cfg)
     ok_
@@ -1795,15 +1802,15 @@ processChatCommand = \case
     asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_
   SendFile chatName f -> withUser $ \user -> do
     chatRef <- getChatRef user chatName
-    processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCFile "")
-  SendImage chatName f -> withUser $ \user -> do
+    processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just f) Nothing (MCFile "")
+  SendImage chatName f@(CryptoFile fPath _) -> withUser $ \user -> do
     chatRef <- getChatRef user chatName
-    filePath <- toFSFilePath f
-    unless (any (`isSuffixOf` map toLower f) imageExtensions) $ throwChatError CEFileImageType {filePath}
+    filePath <- toFSFilePath fPath
+    unless (any (`isSuffixOf` map toLower fPath) imageExtensions) $ throwChatError CEFileImageType {filePath}
     fileSize <- getFileSize filePath
     unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath}
     -- TODO include file description for preview
-    processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCImage "" fixedImagePreview)
+    processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview)
   ForwardFile chatName fileId -> forwardFile chatName fileId SendFile
   ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
   SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO"
@@ -1905,19 +1912,21 @@ processChatCommand = \case
     let pref = uncurry TimedMessagesGroupPreference $ maybe (FEOff, Just 86400) (\ttl -> (FEOn, Just ttl)) ttl_
     updateGroupProfileByName gName $ \p ->
       p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
-  SetLocalDeviceName name -> withUser $ \_ -> chatWriteVar localDeviceName name >> ok_
+  SetLocalDeviceName name -> withUser_ $ chatWriteVar localDeviceName name >> ok_
   CreateRemoteHost -> CRRemoteHostCreated <$> createRemoteHost
   ListRemoteHosts -> CRRemoteHostList <$> listRemoteHosts
   StartRemoteHost rh -> startRemoteHost rh >> ok_
   StopRemoteHost rh -> closeRemoteHostSession rh >> ok_
   DeleteRemoteHost rh -> deleteRemoteHost rh >> ok_
-  StartRemoteCtrl -> startRemoteCtrl (execChatCommand Nothing) >> ok_
-  RegisterRemoteCtrl oob -> CRRemoteCtrlRegistered <$> withStore' (`insertRemoteCtrl` oob)
-  AcceptRemoteCtrl rc -> acceptRemoteCtrl rc >> ok_
-  RejectRemoteCtrl rc -> rejectRemoteCtrl rc >> ok_
-  StopRemoteCtrl -> stopRemoteCtrl >> ok_
-  ListRemoteCtrls -> CRRemoteCtrlList <$> listRemoteCtrls
-  DeleteRemoteCtrl rc -> deleteRemoteCtrl rc >> ok_
+  StoreRemoteFile rh encrypted_ localPath -> CRRemoteFileStored rh <$> storeRemoteFile rh encrypted_ localPath
+  GetRemoteFile rh rf -> getRemoteFile rh rf >> ok_
+  StartRemoteCtrl -> withUser_ $ startRemoteCtrl (execChatCommand Nothing) >> ok_
+  RegisterRemoteCtrl oob -> withUser_ $ CRRemoteCtrlRegistered <$> withStore' (`insertRemoteCtrl` oob)
+  AcceptRemoteCtrl rc -> withUser_ $ acceptRemoteCtrl rc >> ok_
+  RejectRemoteCtrl rc -> withUser_ $ rejectRemoteCtrl rc >> ok_
+  StopRemoteCtrl -> withUser_ $ stopRemoteCtrl >> ok_
+  ListRemoteCtrls -> withUser_ $ CRRemoteCtrlList <$> listRemoteCtrls
+  DeleteRemoteCtrl rc -> withUser_ $ deleteRemoteCtrl rc >> ok_
   QuitChat -> liftIO exitSuccess
   ShowVersion -> do
     let versionInfo = coreVersionInfo $(simplexmqCommitQ)
@@ -2173,14 +2182,14 @@ processChatCommand = \case
     withServerProtocol p action = case userProtocol p of
       Just Dict -> action
       _ -> throwChatError $ CEServerProtocol $ AProtocolType p
-    forwardFile :: ChatName -> FileTransferId -> (ChatName -> FilePath -> ChatCommand) -> m ChatResponse
+    forwardFile :: ChatName -> FileTransferId -> (ChatName -> CryptoFile -> ChatCommand) -> m ChatResponse
     forwardFile chatName fileId sendCommand = withUser $ \user -> do
       withStore (\db -> getFileTransfer db user fileId) >>= \case
-        FTRcv RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}} -> forward filePath
-        FTSnd {fileTransferMeta = FileTransferMeta {filePath}} -> forward filePath
+        FTRcv RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}, cryptoArgs} -> forward filePath cryptoArgs
+        FTSnd {fileTransferMeta = FileTransferMeta {filePath, xftpSndFile}} -> forward filePath $ xftpSndFile >>= \f -> f.cryptoArgs
         _ -> throwChatError CEFileNotReceived {fileId}
       where
-        forward = processChatCommand . sendCommand chatName
+        forward path cfArgs = processChatCommand . sendCommand chatName $ CryptoFile path cfArgs
     getGroupAndMemberId :: User -> GroupName -> ContactName -> m (GroupId, GroupMemberId)
     getGroupAndMemberId user gName groupMemberName =
       withStore $ \db -> do
@@ -2575,10 +2584,9 @@ startReceivingFile user fileId = do
 getRcvFilePath :: forall m. ChatMonad m => FileTransferId -> Maybe FilePath -> String -> Bool -> m FilePath
 getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
   Nothing ->
-    asks filesFolder >>= readTVarIO >>= \case
-      Nothing -> do
-        dir <- (`combine` "Downloads") <$> getHomeDirectory
-        ifM (doesDirectoryExist dir) (pure dir) getChatTempDirectory
+    chatReadVar filesFolder >>= \case
+      Nothing ->
+        getDefaultFilesFolder
           >>= (`uniqueCombine` fn)
           >>= createEmptyFile
       Just filesFolder ->
@@ -2607,18 +2615,6 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
     getTmpHandle :: FilePath -> m Handle
     getTmpHandle fPath = openFile fPath AppendMode `catchThrow` (ChatError . CEFileInternal . show)
 
-uniqueCombine :: MonadIO m => FilePath -> String -> m FilePath
-uniqueCombine filePath fileName = tryCombine (0 :: Int)
-  where
-    tryCombine n =
-      let (name, ext) = splitExtensions fileName
-          suffix = if n == 0 then "" else "_" <> show n
-          f = filePath `combine` (name <> suffix <> ext)
-       in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
-
-getChatTempDirectory :: ChatMonad m => m FilePath
-getChatTempDirectory = chatReadVar tempDirectory >>= maybe getTemporaryDirectory pure
-
 acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
 acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile = do
   subMode <- chatReadVar subscriptionMode
@@ -5575,6 +5571,9 @@ withUser :: ChatMonad m => (User -> m ChatResponse) -> m ChatResponse
 withUser action = withUser' $ \user ->
   ifM chatStarted (action user) (throwChatError CEChatNotStarted)
 
+withUser_ :: ChatMonad m => m ChatResponse -> m ChatResponse
+withUser_ = withUser . const
+
 withUserId :: ChatMonad m => UserId -> (User -> m ChatResponse) -> m ChatResponse
 withUserId userId action = withUser $ \user -> do
   checkSameUser userId user
@@ -5635,6 +5634,7 @@ chatCommandP =
       "/_resubscribe all" $> ResubscribeAllConnections,
       "/_temp_folder " *> (SetTempFolder <$> filePath),
       ("/_files_folder " <|> "/files_folder ") *> (SetFilesFolder <$> filePath),
+      "/remote_hosts_folder " *> (SetRemoteHostsFolder <$> filePath),
       "/_xftp " *> (APISetXFTPConfig <$> ("on " *> (Just <$> jsonP) <|> ("off" $> Nothing))),
       "/xftp " *> (APISetXFTPConfig <$> ("on" *> (Just <$> xftpCfgP) <|> ("off" $> Nothing))),
       "/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP),
@@ -5809,8 +5809,8 @@ chatCommandP =
       "/show" *> (ShowLiveItems <$> (A.space *> onOffP <|> pure True)),
       "/show " *> (ShowChatItem . Just <$> A.decimal),
       "/item info " *> (ShowChatItemInfo <$> chatNameP <* A.space <*> msgTextP),
-      ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> filePath),
-      ("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> filePath),
+      ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> cryptoFileP),
+      ("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> cryptoFileP),
       ("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal),
       ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> chatNameP' <* A.space <*> A.decimal),
       ("/fdescription " <|> "/fd") *> (SendFileDescription <$> chatNameP' <* A.space <*> filePath),
@@ -5858,6 +5858,8 @@ chatCommandP =
       "/start remote host " *> (StartRemoteHost <$> A.decimal),
       "/stop remote host " *> (StopRemoteHost <$> A.decimal),
       "/delete remote host " *> (DeleteRemoteHost <$> A.decimal),
+      "/store remote file " *> (StoreRemoteFile <$> A.decimal <*> optional (" encrypt=" *> onOffP) <* A.space <*> filePath),
+      "/get remote file " *> (GetRemoteFile <$> A.decimal <* A.space <*> jsonP),
       "/start remote ctrl" $> StartRemoteCtrl,
       "/register remote ctrl " *> (RegisterRemoteCtrl <$> (RemoteCtrlOOB <$> strP <* A.space <*> textP)),
       "/_register remote ctrl " *> (RegisterRemoteCtrl <$> jsonP),
@@ -5932,6 +5934,10 @@ chatCommandP =
     msgTextP = jsonP <|> textP
     stringP = T.unpack . safeDecodeUtf8 <$> A.takeByteString
     filePath = stringP
+    cryptoFileP = do
+      cfArgs <- optional $ CFArgs <$> (" key=" *> strP <* A.space) <*> (" nonce=" *> strP)
+      path <- filePath
+      pure $ CryptoFile path cfArgs
     memberRole =
       A.choice
         [ " owner" $> GROwner,
diff --git a/src/Simplex/Chat/Archive.hs b/src/Simplex/Chat/Archive.hs
index e0de971bd..dd098e016 100644
--- a/src/Simplex/Chat/Archive.hs
+++ b/src/Simplex/Chat/Archive.hs
@@ -9,6 +9,7 @@ module Simplex.Chat.Archive
     importArchive,
     deleteStorage,
     sqlCipherExport,
+    archiveFilesFolder,
   )
 where
 
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 66ab513a0..bc4cfaaf8 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -178,6 +178,7 @@ data ChatController = ChatController
     currentCalls :: TMap ContactId Call,
     localDeviceName :: TVar Text,
     remoteHostSessions :: TMap RemoteHostId RemoteHostSession, -- All the active remote hosts
+    remoteHostsFolder :: TVar (Maybe FilePath), -- folder for remote hosts data
     remoteCtrlSession :: TVar (Maybe RemoteCtrlSession), -- Supervisor process for hosted controllers
     config :: ChatConfig,
     filesFolder :: TVar (Maybe FilePath), -- path to files folder for mobile apps,
@@ -224,6 +225,7 @@ data ChatCommand
   | ResubscribeAllConnections
   | SetTempFolder FilePath
   | SetFilesFolder FilePath
+  | SetRemoteHostsFolder FilePath
   | APISetXFTPConfig (Maybe XFTPFileConfig)
   | APISetEncryptLocalFiles Bool
   | SetContactMergeEnabled Bool
@@ -393,8 +395,8 @@ data ChatCommand
   | ShowChatItem (Maybe ChatItemId) -- UserId (not used in UI)
   | ShowChatItemInfo ChatName Text
   | ShowLiveItems Bool
-  | SendFile ChatName FilePath
-  | SendImage ChatName FilePath
+  | SendFile ChatName CryptoFile
+  | SendImage ChatName CryptoFile
   | ForwardFile ChatName FileTransferId
   | ForwardImage ChatName FileTransferId
   | SendFileDescription ChatName FilePath
@@ -419,6 +421,8 @@ data ChatCommand
   -- | SwitchRemoteHost (Maybe RemoteHostId) -- ^ Switch current remote host
   | StopRemoteHost RemoteHostId -- ^ Shut down a running session
   | DeleteRemoteHost RemoteHostId -- ^ Unregister remote host and remove its data
+  | StoreRemoteFile {remoteHostId :: RemoteHostId, storeEncrypted :: Maybe Bool, localPath :: FilePath}
+  | GetRemoteFile {remoteHostId :: RemoteHostId, file :: RemoteFile}
   | StartRemoteCtrl -- ^ Start listening for announcements from all registered controllers
   | RegisterRemoteCtrl RemoteCtrlOOB -- ^ Register OOB data for satellite discovery and handshake
   | ListRemoteCtrls
@@ -440,22 +444,27 @@ allowRemoteCommand = \case
   StartChat {} -> False
   APIStopChat -> False
   APIActivateChat -> False
-  APISuspendChat {} -> False
-  SetTempFolder {} -> False
+  APISuspendChat _ -> False
+  SetTempFolder _ -> False
   QuitChat -> False
   CreateRemoteHost -> False
   ListRemoteHosts -> False
-  StartRemoteHost {} -> False
+  StartRemoteHost _ -> False
   -- SwitchRemoteHost {} -> False
-  StopRemoteHost {} -> False
-  DeleteRemoteHost {} -> False
+  StoreRemoteFile {} -> False
+  GetRemoteFile {} -> False
+  StopRemoteHost _ -> False
+  DeleteRemoteHost _ -> False
   RegisterRemoteCtrl {} -> False
   StartRemoteCtrl -> False
   ListRemoteCtrls -> False
-  AcceptRemoteCtrl {} -> False
-  RejectRemoteCtrl {} -> False
+  AcceptRemoteCtrl _ -> False
+  RejectRemoteCtrl _ -> False
   StopRemoteCtrl -> False
-  DeleteRemoteCtrl {} -> False
+  DeleteRemoteCtrl _ -> False
+  ExecChatStoreSQL _ -> False
+  ExecAgentStoreSQL _ -> False
+  SlowSQLQueries -> False
   _ -> True
 
 data ChatResponse
@@ -627,6 +636,7 @@ data ChatResponse
   | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
   | CRRemoteHostConnected {remoteHost :: RemoteHostInfo}
   | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
+  | CRRemoteFileStored {remoteHostId :: RemoteHostId, remoteFileSource :: CryptoFile}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlRegistered {remoteCtrl :: RemoteCtrlInfo}
   | CRRemoteCtrlAnnounce {fingerprint :: C.KeyHash} -- unregistered fingerprint, needs confirmation
diff --git a/src/Simplex/Chat/Files.hs b/src/Simplex/Chat/Files.hs
new file mode 100644
index 000000000..845b237cd
--- /dev/null
+++ b/src/Simplex/Chat/Files.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Simplex.Chat.Files where
+
+import Control.Monad.IO.Class
+import Simplex.Chat.Controller
+import Simplex.Messaging.Util (ifM)
+import System.FilePath (splitExtensions, combine)
+import UnliftIO.Directory (doesFileExist, getTemporaryDirectory, getHomeDirectory, doesDirectoryExist)
+
+uniqueCombine :: MonadIO m => FilePath -> String -> m FilePath
+uniqueCombine fPath fName = tryCombine (0 :: Int)
+  where
+    tryCombine n =
+      let (name, ext) = splitExtensions fName
+          suffix = if n == 0 then "" else "_" <> show n
+          f = fPath `combine` (name <> suffix <> ext)
+       in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
+
+getChatTempDirectory :: ChatMonad m => m FilePath
+getChatTempDirectory = chatReadVar tempDirectory >>= maybe getTemporaryDirectory pure
+
+getDefaultFilesFolder :: ChatMonad m => m FilePath
+getDefaultFilesFolder = do
+  dir <- (`combine` "Downloads") <$> getHomeDirectory
+  ifM (doesDirectoryExist dir) (pure dir) getChatTempDirectory
diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs
index 2718b088b..8ea33e0ab 100644
--- a/src/Simplex/Chat/Messages.hs
+++ b/src/Simplex/Chat/Messages.hs
@@ -24,6 +24,7 @@ import qualified Data.Aeson.TH as JQ
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Char (isSpace)
 import Data.Int (Int64)
 import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
@@ -53,7 +54,7 @@ data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection
 data ChatName = ChatName {chatType :: ChatType, chatName :: Text}
   deriving (Show)
 
-chatTypeStr :: ChatType -> String
+chatTypeStr :: ChatType -> Text
 chatTypeStr = \case
   CTDirect -> "@"
   CTGroup -> "#"
@@ -61,7 +62,7 @@ chatTypeStr = \case
   CTContactConnection -> ":"
 
 chatNameStr :: ChatName -> String
-chatNameStr (ChatName cType name) = chatTypeStr cType <> T.unpack name
+chatNameStr (ChatName cType name) = T.unpack $ chatTypeStr cType <> if T.any isSpace name then "'" <> name <> "'" else name
 
 data ChatRef = ChatRef ChatType Int64
   deriving (Eq, Show, Ord)
diff --git a/src/Simplex/Chat/Mobile/File.hs b/src/Simplex/Chat/Mobile/File.hs
index 99860bbfa..1da64a304 100644
--- a/src/Simplex/Chat/Mobile/File.hs
+++ b/src/Simplex/Chat/Mobile/File.hs
@@ -99,7 +99,7 @@ chatEncryptFile fromPath toPath =
   either WFError WFResult <$> runCatchExceptT encrypt
   where
     encrypt = do
-      cfArgs <- liftIO $ CF.randomArgs
+      cfArgs <- liftIO CF.randomArgs
       encryptFile fromPath toPath cfArgs
       pure cfArgs
 
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index c195b4631..5344c4bea 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -16,7 +16,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
-import Control.Monad.Reader (asks)
+import Control.Monad.Reader
 import Control.Monad.STM (retry)
 import Crypto.Random (getRandomBytes)
 import qualified Data.Aeson as J
@@ -34,21 +34,35 @@ import Data.Word (Word32)
 import Network.HTTP2.Server (responseStreaming)
 import qualified Network.HTTP.Types as N
 import Network.Socket (SockAddr (..), hostAddressToTuple)
+import Simplex.Chat.Archive (archiveFilesFolder)
 import Simplex.Chat.Controller
+import Simplex.Chat.Files
+import Simplex.Chat.Messages (chatNameStr)
 import qualified Simplex.Chat.Remote.Discovery as Discovery
 import Simplex.Chat.Remote.Protocol
+import Simplex.Chat.Remote.Transport
 import Simplex.Chat.Remote.Types
+import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Remote
+import Simplex.Chat.Store.Shared
+import Simplex.Chat.Types (User (..))
+import Simplex.Chat.Util (encryptFile)
+import Simplex.FileTransfer.Description (FileDigest (..))
 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 Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
-import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
-import Simplex.Messaging.Util (ifM, liftEitherError, liftEitherWith, liftError, liftIOEither, tryAllErrors, tshow, ($>>=))
-import System.FilePath ((</>))
+import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
+import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Util (ifM, liftEitherError, liftEitherWith, liftError, liftIOEither, tryAllErrors, tshow, ($>>=), (<$$>))
+import System.FilePath ((</>), takeFileName)
 import UnliftIO
+import UnliftIO.Directory (copyFile, createDirectoryIfMissing, renameFile)
+import Data.Functor (($>))
+import Control.Applicative ((<|>))
 
 -- * Desktop side
 
@@ -110,7 +124,7 @@ startRemoteHost rhId = do
       toView $ CRRemoteHostConnected RemoteHostInfo
         { remoteHostId = rhId,
           storePath = storePath,
-          displayName = remoteDeviceName remoteHostClient,
+          displayName = hostDeviceName remoteHostClient,
           remoteCtrlOOB = RemoteCtrlOOB {fingerprint, displayName=rcName},
           sessionActive = True
         }
@@ -178,9 +192,57 @@ deleteRemoteHost rhId = do
     Nothing -> logWarn "Local file store not available while deleting remote host"
   withStore' (`deleteRemoteHostRecord` rhId)
 
-processRemoteCommand :: ChatMonad m => RemoteHostId -> RemoteHostSession -> ByteString -> m ChatResponse
-processRemoteCommand remoteHostId RemoteHostSession {remoteHostClient = Just rhc} s = liftRH remoteHostId $ remoteSend rhc s
-processRemoteCommand _ _ _ = pure $ chatCmdError Nothing "remote command sent before session started"
+storeRemoteFile :: forall m. ChatMonad m => RemoteHostId -> Maybe Bool -> FilePath -> m CryptoFile
+storeRemoteFile rhId encrypted_ localPath = do
+  RemoteHostSession {remoteHostClient, storePath} <- getRemoteHostSession rhId
+  case remoteHostClient of
+    Nothing -> throwError $ ChatErrorRemoteHost rhId RHMissing
+    Just c@RemoteHostClient {encryptHostFiles} -> do
+      let encrypt = fromMaybe encryptHostFiles encrypted_
+      cf@CryptoFile {filePath} <- if encrypt then encryptLocalFile else pure $ CF.plain localPath
+      filePath' <- liftRH rhId $ remoteStoreFile c filePath (takeFileName localPath)
+      hf_ <- chatReadVar remoteHostsFolder
+      forM_ hf_ $ \hf -> do
+        let rhf = hf </> storePath </> archiveFilesFolder
+            hPath = rhf </> takeFileName filePath'
+        createDirectoryIfMissing True rhf
+        (if encrypt then renameFile else copyFile) filePath hPath
+      pure (cf :: CryptoFile) {filePath = filePath'}
+  where
+    encryptLocalFile :: m CryptoFile
+    encryptLocalFile = do
+      tmpDir <- getChatTempDirectory
+      createDirectoryIfMissing True tmpDir
+      tmpFile <- tmpDir `uniqueCombine` takeFileName localPath
+      cfArgs <- liftIO CF.randomArgs
+      liftError (ChatError . CEFileWrite tmpFile) $ encryptFile localPath tmpFile cfArgs
+      pure $ CryptoFile tmpFile $ Just cfArgs
+
+getRemoteFile :: ChatMonad m => RemoteHostId -> RemoteFile -> m ()
+getRemoteFile rhId rf = do
+  RemoteHostSession {remoteHostClient, storePath} <- getRemoteHostSession rhId
+  case remoteHostClient of
+    Nothing -> throwError $ ChatErrorRemoteHost rhId RHMissing
+    Just c -> do
+      dir <- (</> storePath </> archiveFilesFolder) <$> (maybe getDefaultFilesFolder pure =<< chatReadVar remoteHostsFolder)
+      createDirectoryIfMissing True dir
+      liftRH rhId $ remoteGetFile c dir rf
+
+processRemoteCommand :: ChatMonad m => RemoteHostId -> RemoteHostSession -> ChatCommand -> ByteString -> m ChatResponse
+processRemoteCommand remoteHostId RemoteHostSession {remoteHostClient = Just rhc} cmd s = case cmd of
+  SendFile chatName f -> sendFile "/f" chatName f
+  SendImage chatName f -> sendFile "/img" chatName f    
+  _ -> liftRH remoteHostId $ remoteSend rhc s
+  where
+    sendFile cmdName chatName (CryptoFile path cfArgs) = do
+      -- don't encrypt in host if already encrypted locally
+      CryptoFile path' cfArgs' <- storeRemoteFile remoteHostId (cfArgs $> False) path
+      let f = CryptoFile path' (cfArgs <|> cfArgs') -- use local or host encryption
+      liftRH remoteHostId $ remoteSend rhc $ B.unwords [cmdName, B.pack (chatNameStr chatName), cryptoFileStr f]
+    cryptoFileStr CryptoFile {filePath, cryptoArgs} =
+      maybe "" (\(CFArgs key nonce) -> "key=" <> strEncode key <> " nonce=" <> strEncode nonce <> " ") cryptoArgs
+        <> encodeUtf8 (T.pack filePath)
+processRemoteCommand _ _ _ _ = pure $ chatCmdError Nothing "remote command sent before session started"
 
 liftRH :: ChatMonad m => RemoteHostId -> ExceptT RemoteProtocolError IO a -> m a
 liftRH rhId = liftError (ChatErrorRemoteHost rhId . RHProtocolError)
@@ -218,20 +280,24 @@ handleRemoteCommand :: forall m . ChatMonad m => (ByteString -> m ChatResponse)
 handleRemoteCommand execChatCommand remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
   logDebug "handleRemoteCommand"
   liftRC (tryRemoteError parseRequest) >>= \case
-    Right (getNext, rc) -> processCommand getNext rc `catchAny` (reply . RRProtocolError . RPEException . tshow)
+    Right (getNext, rc) -> do
+      chatReadVar currentUser >>= \case
+        Nothing -> replyError $ ChatError CENoActiveUser
+        Just user -> processCommand user getNext rc `catchChatError` replyError
     Left e -> reply $ RRProtocolError e
   where
     parseRequest :: ExceptT RemoteProtocolError IO (GetChunk, RemoteCommand)
     parseRequest = do
       (header, getNext) <- parseHTTP2Body request reqBody
       (getNext,) <$> liftEitherWith (RPEInvalidJSON . T.pack) (J.eitherDecodeStrict' header)
-    processCommand :: GetChunk -> RemoteCommand -> m ()
-    processCommand getNext = \case
+    replyError = reply . RRChatResponse . CRChatCmdError Nothing
+    processCommand :: User -> GetChunk -> RemoteCommand -> m ()
+    processCommand user getNext = \case
       RCHello {deviceName = desktopName} -> handleHello desktopName >>= reply
       RCSend {command} -> handleSend execChatCommand command >>= reply
       RCRecv {wait = time} -> handleRecv time remoteOutputQ >>= reply
-      RCStoreFile {fileSize, encrypt} -> handleStoreFile fileSize encrypt getNext >>= reply
-      RCGetFile {filePath} -> handleGetFile filePath replyWith
+      RCStoreFile {fileName, fileSize, fileDigest} -> handleStoreFile fileName fileSize fileDigest getNext >>= reply
+      RCGetFile {file} -> handleGetFile user file replyWith
     reply :: RemoteResponse -> m ()
     reply = (`replyWith` \_ -> pure ())
     replyWith :: Respond m
@@ -258,7 +324,8 @@ handleHello :: ChatMonad m => Text -> m RemoteResponse
 handleHello desktopName = do
   logInfo $ "Hello from " <> tshow desktopName
   mobileName <- chatReadVar localDeviceName
-  pure RRHello {encoding = localEncoding, deviceName = mobileName}
+  encryptFiles <- chatReadVar encryptLocalFiles
+  pure RRHello {encoding = localEncoding, deviceName = mobileName, encryptFiles}
 
 handleSend :: ChatMonad m => (ByteString -> m ChatResponse) -> Text -> m RemoteResponse
 handleSend execChatCommand command = do
@@ -272,20 +339,36 @@ handleRecv time events = do
   logDebug $ "Recv: " <> tshow time
   RRChatEvent <$> (timeout time . atomically $ readTBQueue events)
 
-handleStoreFile :: ChatMonad m => Word32 -> Maybe Bool -> GetChunk -> m RemoteResponse
-handleStoreFile _fileSize _encrypt _getNext = error "TODO" <$ logError "TODO: handleStoreFile"
+-- TODO this command could remember stored files and return IDs to allow removing files that are not needed.
+-- Also, there should be some process removing unused files uploaded to remote host (possibly, all unused files).
+handleStoreFile :: forall m. ChatMonad m => FilePath -> Word32 -> FileDigest -> GetChunk -> m RemoteResponse
+handleStoreFile fileName fileSize fileDigest getChunk =
+  either RRProtocolError RRFileStored <$> (chatReadVar filesFolder >>= storeFile)
+  where
+    storeFile :: Maybe FilePath -> m (Either RemoteProtocolError FilePath)
+    storeFile = \case
+      Just ff -> takeFileName <$$> storeFileTo ff
+      Nothing -> storeFileTo =<< getDefaultFilesFolder
+    storeFileTo :: FilePath -> m (Either RemoteProtocolError FilePath)
+    storeFileTo dir = liftRC . tryRemoteError $ do
+      filePath <- dir `uniqueCombine` fileName
+      receiveRemoteFile getChunk fileSize fileDigest filePath
+      pure filePath
 
-handleGetFile :: ChatMonad m => FilePath -> Respond m -> m ()
-handleGetFile path reply = do
-  logDebug $ "GetFile: " <> tshow path
-  withFile path ReadMode $ \h -> do
-    fileSize' <- hFileSize h
-    when (fileSize' > toInteger (maxBound :: Word32)) $ throwIO RPEFileTooLarge
-    let fileSize = fromInteger fileSize'
-    reply RRFile {fileSize} $ \send -> hSendFile h send fileSize
+handleGetFile :: ChatMonad m => User -> RemoteFile -> Respond m -> m ()
+handleGetFile User {userId} RemoteFile{userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do
+  logDebug $ "GetFile: " <> tshow filePath
+  unless (userId == commandUserId) $ throwChatError $ CEDifferentActiveUser {commandUserId, activeUserId = userId}
+  path <- maybe filePath (</> filePath) <$> chatReadVar filesFolder
+  withStore $ \db -> do
+    cf <- getLocalCryptoFile db commandUserId fileId sent
+    unless (cf == cf') $ throwError $ SEFileNotFound fileId
+  liftRC (tryRemoteError $ getFileInfo path) >>= \case
+    Left e -> reply (RRProtocolError e) $ \_ -> pure ()
+    Right (fileSize, fileDigest) ->
+      withFile path ReadMode $ \h ->
+        reply RRFile {fileSize, fileDigest} $ \send -> hSendFile h send fileSize
 
--- TODO the problem with this code was that it wasn't clear where the recursion can happen,
--- by splitting receiving and processing to two functions it becomes clear
 discoverRemoteCtrls :: ChatMonad m => TM.TMap C.KeyHash TransportHost -> m ()
 discoverRemoteCtrls discovered = Discovery.withListener $ receive >=> process
   where
diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs
index aa4ebe595..2deb17777 100644
--- a/src/Simplex/Chat/Remote/Protocol.hs
+++ b/src/Simplex/Chat/Remote/Protocol.hs
@@ -20,7 +20,7 @@ import Data.Aeson.TH (deriveJSON)
 import qualified Data.Aeson.Types as JT
 import Data.ByteString (ByteString)
 import Data.ByteString.Builder (Builder, word32BE, lazyByteString)
-import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy as LB
 import Data.String (fromString)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8)
@@ -28,34 +28,35 @@ import Data.Word (Word32)
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Client as H
 import Network.Transport.Internal (decodeWord32)
-import Simplex.Chat.Controller (ChatResponse)
+import Simplex.Chat.Controller
+import Simplex.Chat.Remote.Transport
 import Simplex.Chat.Remote.Types
-import Simplex.Messaging.Crypto.File (CryptoFile)
+import Simplex.FileTransfer.Description (FileDigest (..))
+import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON, pattern SingleFieldJSONTag, pattern TaggedObjectJSONData, pattern TaggedObjectJSONTag)
 import Simplex.Messaging.Transport.Buffer (getBuffered)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), HTTP2BodyChunk, getBodyChunk)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2Response (..), closeHTTP2Client, sendRequestDirect)
-import Simplex.Messaging.Transport.HTTP2.File (hReceiveFile, hSendFile)
-import Simplex.Messaging.Util (liftEitherError, liftEitherWith, tshow, whenM)
-import System.FilePath ((</>))
+import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
+import Simplex.Messaging.Util (liftEitherError, liftEitherWith, tshow)
+import System.FilePath ((</>), takeFileName)
 import UnliftIO
-import UnliftIO.Directory (doesFileExist, getFileSize)
 
 data RemoteCommand
   = RCHello {deviceName :: Text}
   | RCSend {command :: Text} -- TODO maybe ChatCommand here?
   | RCRecv {wait :: Int} -- this wait should be less than HTTP timeout
   | -- local file encryption is determined by the host, but can be overridden for videos
-    RCStoreFile {fileSize :: Word32, encrypt :: Maybe Bool} -- requires attachment
-  | RCGetFile {filePath :: FilePath}
+    RCStoreFile {fileName :: String, fileSize :: Word32, fileDigest :: FileDigest} -- requires attachment
+  | RCGetFile {file :: RemoteFile}
   deriving (Show)
 
 data RemoteResponse
-  = RRHello {encoding :: PlatformEncoding, deviceName :: Text}
+  = RRHello {encoding :: PlatformEncoding, deviceName :: Text, encryptFiles :: Bool}
   | RRChatResponse {chatResponse :: ChatResponse}
   | RRChatEvent {chatEvent :: Maybe ChatResponse} -- ^ 'Nothing' on poll timeout
-  | RRFileStored {fileSource :: CryptoFile}
-  | RRFile {fileSize :: Word32} -- provides attachment
+  | RRFileStored {filePath :: String}
+  | RRFile {fileSize :: Word32, fileDigest :: FileDigest} -- provides attachment , fileDigest :: FileDigest
   | RRProtocolError {remoteProcotolError :: RemoteProtocolError} -- ^ The protocol error happened on the server side
   deriving (Show)
 
@@ -67,14 +68,13 @@ $(deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse)
 
 createRemoteHostClient :: HTTP2Client -> Text -> ExceptT RemoteProtocolError IO RemoteHostClient
 createRemoteHostClient httpClient desktopName = do
-  logInfo "Sending initial hello"
-  (_getNext, rr) <- sendRemoteCommand httpClient localEncoding Nothing RCHello {deviceName = desktopName}
-  case rr of
-    rrh@RRHello {encoding, deviceName = mobileName} -> do
-      logInfo $ "Got initial hello: " <> tshow rrh
+  logDebug "Sending initial hello"
+  sendRemoteCommand' httpClient localEncoding Nothing RCHello {deviceName = desktopName} >>= \case
+    RRHello {encoding, deviceName = mobileName, encryptFiles} -> do
+      logDebug "Got initial hello"
       when (encoding == PEKotlin && localEncoding == PESwift) $ throwError RPEIncompatibleEncoding
-      pure RemoteHostClient {remoteEncoding = encoding, remoteDeviceName = mobileName, httpClient}
-    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+      pure RemoteHostClient {hostEncoding = encoding, hostDeviceName = mobileName, httpClient, encryptHostFiles = encryptFiles}
+    r -> badResponse r
 
 closeRemoteHostClient :: MonadIO m => RemoteHostClient -> m ()
 closeRemoteHostClient RemoteHostClient {httpClient} = liftIO $ closeHTTP2Client httpClient
@@ -82,48 +82,37 @@ closeRemoteHostClient RemoteHostClient {httpClient} = liftIO $ closeHTTP2Client
 -- ** Commands
 
 remoteSend :: RemoteHostClient -> ByteString -> ExceptT RemoteProtocolError IO ChatResponse
-remoteSend RemoteHostClient {httpClient, remoteEncoding} cmd = do
-  (_getNext, rr) <- sendRemoteCommand httpClient remoteEncoding Nothing RCSend {command = decodeUtf8 cmd}
-  case rr of
+remoteSend RemoteHostClient {httpClient, hostEncoding} cmd =
+  sendRemoteCommand' httpClient hostEncoding Nothing RCSend {command = decodeUtf8 cmd} >>= \case
     RRChatResponse cr -> pure cr
-    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+    r -> badResponse r
 
 remoteRecv :: RemoteHostClient -> Int -> ExceptT RemoteProtocolError IO (Maybe ChatResponse)
-remoteRecv RemoteHostClient {httpClient, remoteEncoding} ms = do
-  (_getNext, rr) <- sendRemoteCommand httpClient remoteEncoding Nothing RCRecv {wait=ms}
-  case rr of
+remoteRecv RemoteHostClient {httpClient, hostEncoding} ms =
+  sendRemoteCommand' httpClient hostEncoding Nothing RCRecv {wait = ms} >>= \case
     RRChatEvent cr_ -> pure cr_
-    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+    r -> badResponse r
 
-remoteStoreFile :: RemoteHostClient -> FilePath -> Maybe Bool -> ExceptT RemoteProtocolError IO CryptoFile
-remoteStoreFile RemoteHostClient {httpClient, remoteEncoding} localPath encrypt = do
-  (_getNext, rr) <- withFile localPath ReadMode $ \h -> do
-    fileSize' <- hFileSize h
-    when (fileSize' > toInteger (maxBound :: Word32)) $ throwError RPEFileTooLarge
-    let fileSize = fromInteger fileSize'
-    sendRemoteCommand httpClient remoteEncoding (Just (h, fileSize)) RCStoreFile {encrypt, fileSize}
-  case rr of
-    RRFileStored {fileSource} -> pure fileSource
-    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+remoteStoreFile :: RemoteHostClient -> FilePath -> FilePath -> ExceptT RemoteProtocolError IO FilePath
+remoteStoreFile RemoteHostClient {httpClient, hostEncoding} localPath fileName = do
+  (fileSize, fileDigest) <- getFileInfo localPath
+  let send h = sendRemoteCommand' httpClient hostEncoding (Just (h, fileSize)) RCStoreFile {fileName, fileSize, fileDigest}
+  withFile localPath ReadMode send >>= \case
+    RRFileStored {filePath = filePath'} -> pure filePath'
+    r -> badResponse r
 
--- TODO this should work differently for CLI and UI clients
--- CLI - potentially, create new unique names and report them as created
--- UI - always use the same names and report error if file already exists
--- alternatively, CLI should also use a fixed folder for remote session
--- Possibly, path in the database should be optional and CLI commands should allow configuring it per session or use temp or download folder
-remoteGetFile :: RemoteHostClient -> FilePath -> FilePath -> ExceptT RemoteProtocolError IO FilePath
-remoteGetFile RemoteHostClient {httpClient, remoteEncoding} baseDir filePath = do
-  (getNext, rr) <- sendRemoteCommand httpClient remoteEncoding Nothing RCGetFile {filePath}
-  expectedSize <- case rr of
-    RRFile {fileSize} -> pure fileSize
-    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
-  whenM (liftIO $ doesFileExist localFile) $ throwError RPEStoredFileExists
-  rc <- liftIO $ withFile localFile WriteMode $ \h -> hReceiveFile getNext h expectedSize
-  when (rc /= 0) $ throwError RPEInvalidSize
-  whenM ((== expectedSize) . fromIntegral <$> getFileSize localFile) $ throwError RPEInvalidSize
-  pure localFile
-  where
-    localFile = baseDir </> filePath
+remoteGetFile :: RemoteHostClient -> FilePath -> RemoteFile -> ExceptT RemoteProtocolError IO ()
+remoteGetFile RemoteHostClient {httpClient, hostEncoding} destDir rf@RemoteFile {fileSource = CryptoFile {filePath}} =
+  sendRemoteCommand httpClient hostEncoding Nothing RCGetFile {file = rf} >>= \case
+    (getChunk, RRFile {fileSize, fileDigest}) -> do
+      -- TODO we could optimize by checking size and hash before receiving the file
+      let localPath = destDir </> takeFileName filePath
+      receiveRemoteFile getChunk fileSize fileDigest localPath
+    (_, r) -> badResponse r
+
+-- TODO validate there is no attachment
+sendRemoteCommand' :: HTTP2Client -> PlatformEncoding -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO RemoteResponse
+sendRemoteCommand' http remoteEncoding attachment_ rc = snd <$> sendRemoteCommand http remoteEncoding attachment_ rc
 
 sendRemoteCommand :: HTTP2Client -> PlatformEncoding -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO (Int -> IO ByteString, RemoteResponse)
 sendRemoteCommand http remoteEncoding attachment_ rc = do
@@ -139,6 +128,12 @@ sendRemoteCommand http remoteEncoding attachment_ rc = do
         Just (h, sz) -> hSendFile h send sz
       flush
 
+badResponse :: RemoteResponse -> ExceptT RemoteProtocolError IO a
+badResponse = \case
+  RRProtocolError e -> throwError e
+  -- TODO handle chat errors?
+  r -> throwError $ RPEUnexpectedResponse $ tshow r
+
 -- * Transport-level wrappers
 
 convertJSON :: PlatformEncoding -> PlatformEncoding -> J.Value -> J.Value
@@ -183,7 +178,7 @@ pattern OwsfTag = (SingleFieldJSONTag, J.Bool True)
 
 -- | Convert a command or a response into 'Builder'.
 sizePrefixedEncode :: J.ToJSON a => a -> Builder
-sizePrefixedEncode value = word32BE (fromIntegral $ BL.length json) <> lazyByteString json
+sizePrefixedEncode value = word32BE (fromIntegral $ LB.length json) <> lazyByteString json
   where
     json = J.encode value
 
diff --git a/src/Simplex/Chat/Remote/Transport.hs b/src/Simplex/Chat/Remote/Transport.hs
new file mode 100644
index 000000000..bf798444c
--- /dev/null
+++ b/src/Simplex/Chat/Remote/Transport.hs
@@ -0,0 +1,27 @@
+module Simplex.Chat.Remote.Transport where
+
+import Control.Monad
+import Control.Monad.Except
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LB
+import Data.Word (Word32)
+import Simplex.FileTransfer.Description (FileDigest (..))
+import Simplex.Chat.Remote.Types
+import qualified Simplex.Messaging.Crypto.Lazy as LC
+import Simplex.Messaging.Transport.HTTP2.File (hReceiveFile)
+import UnliftIO
+import UnliftIO.Directory (getFileSize)
+
+receiveRemoteFile :: (Int -> IO ByteString) -> Word32 -> FileDigest -> FilePath -> ExceptT RemoteProtocolError IO ()
+receiveRemoteFile getChunk fileSize fileDigest toPath = do
+  diff <- liftIO $ withFile toPath WriteMode $ \h -> hReceiveFile getChunk h fileSize
+  unless (diff == 0) $ throwError RPEFileSize
+  digest <- liftIO $ LC.sha512Hash <$> LB.readFile toPath
+  unless (FileDigest digest == fileDigest) $ throwError RPEFileDigest
+
+getFileInfo :: FilePath -> ExceptT RemoteProtocolError IO (Word32, FileDigest)
+getFileInfo filePath = do
+  fileDigest <- liftIO $ FileDigest . LC.sha512Hash <$> LB.readFile filePath
+  fileSize' <- getFileSize filePath
+  when (fileSize' > toInteger (maxBound :: Word32)) $ throwError RPEFileSize
+  pure (fromInteger fileSize', fileDigest)
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index d16955199..6611d0447 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -10,14 +10,16 @@ import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (CryptoFile)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
 import UnliftIO
 
 data RemoteHostClient = RemoteHostClient
-  { remoteEncoding :: PlatformEncoding,
-    remoteDeviceName :: Text,
-    httpClient :: HTTP2Client
+  { hostEncoding :: PlatformEncoding,
+    hostDeviceName :: Text,
+    httpClient :: HTTP2Client,
+    encryptHostFiles :: Bool
   }
 
 data RemoteHostSession = RemoteHostSession
@@ -32,7 +34,8 @@ data RemoteProtocolError
   | RPEIncompatibleEncoding
   | RPEUnexpectedFile
   | RPENoFile
-  | RPEFileTooLarge
+  | RPEFileSize
+  | RPEFileDigest
   | RPEUnexpectedResponse {response :: Text} -- ^ Wrong response received for the command sent
   | RPEStoredFileExists -- ^ A file already exists in the destination position
   | RPEHTTP2 {http2Error :: Text}
@@ -87,7 +90,14 @@ data RemoteCtrlInfo = RemoteCtrlInfo
   }
   deriving (Show)
 
--- TODO: put into a proper place
+data RemoteFile = RemoteFile
+  { userId :: Int64,
+    fileId :: Int64,
+    sent :: Bool,
+    fileSource :: CryptoFile
+  }
+  deriving (Show)
+
 data PlatformEncoding
   = PESwift
   | PEKotlin
@@ -122,3 +132,5 @@ $(J.deriveJSON defaultJSON ''RemoteHostInfo)
 $(J.deriveJSON defaultJSON ''RemoteCtrl)
 
 $(J.deriveJSON defaultJSON ''RemoteCtrlInfo)
+
+$(J.deriveJSON defaultJSON ''RemoteFile)
diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs
index a710696da..95e586919 100644
--- a/src/Simplex/Chat/Store/Files.hs
+++ b/src/Simplex/Chat/Store/Files.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -71,6 +72,7 @@ module Simplex.Chat.Store.Files
     getSndFileTransfer,
     getSndFileTransfers,
     getContactFileInfo,
+    getLocalCryptoFile,
     updateDirectCIFileStatus,
   )
 where
@@ -602,7 +604,10 @@ getRcvFileTransferById db fileId = do
   (user,) <$> getRcvFileTransfer db user fileId
 
 getRcvFileTransfer :: DB.Connection -> User -> FileTransferId -> ExceptT StoreError IO RcvFileTransfer
-getRcvFileTransfer db User {userId} fileId = do
+getRcvFileTransfer db User {userId} = getRcvFileTransfer_ db userId
+
+getRcvFileTransfer_ :: DB.Connection -> UserId -> FileTransferId -> ExceptT StoreError IO RcvFileTransfer
+getRcvFileTransfer_ db userId fileId = do
   rftRow <-
     ExceptT . firstRow id (SERcvFileNotFound fileId) $
       DB.query
@@ -808,25 +813,26 @@ getFileTransferProgress db user fileId = do
 
 getFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransfer
 getFileTransfer db user@User {userId} fileId =
-  fileTransfer =<< liftIO getFileTransferRow
+  fileTransfer =<< liftIO (getFileTransferRow_ db userId fileId)
   where
     fileTransfer :: [(Maybe Int64, Maybe Int64)] -> ExceptT StoreError IO FileTransfer
     fileTransfer [(Nothing, Just _)] = FTRcv <$> getRcvFileTransfer db user fileId
     fileTransfer _ = do
       (ftm, fts) <- getSndFileTransfer db user fileId
       pure $ FTSnd {fileTransferMeta = ftm, sndFileTransfers = fts}
-    getFileTransferRow :: IO [(Maybe Int64, Maybe Int64)]
-    getFileTransferRow =
-      DB.query
-        db
-        [sql|
-          SELECT s.file_id, r.file_id
-          FROM files f
-          LEFT JOIN snd_files s ON s.file_id = f.file_id
-          LEFT JOIN rcv_files r ON r.file_id = f.file_id
-          WHERE user_id = ? AND f.file_id = ?
-        |]
-        (userId, fileId)
+
+getFileTransferRow_ :: DB.Connection -> UserId -> Int64 -> IO [(Maybe Int64, Maybe Int64)]
+getFileTransferRow_ db userId fileId =
+  DB.query
+    db
+    [sql|
+      SELECT s.file_id, r.file_id
+      FROM files f
+      LEFT JOIN snd_files s ON s.file_id = f.file_id
+      LEFT JOIN rcv_files r ON r.file_id = f.file_id
+      WHERE user_id = ? AND f.file_id = ?
+    |]
+    (userId, fileId)
 
 getSndFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer])
 getSndFileTransfer db user fileId = do
@@ -861,7 +867,10 @@ getSndFileTransfers_ db userId fileId =
         Nothing -> Left $ SESndFileInvalid fileId
 
 getFileTransferMeta :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransferMeta
-getFileTransferMeta db User {userId} fileId =
+getFileTransferMeta db User {userId} = getFileTransferMeta_ db userId
+
+getFileTransferMeta_ :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO FileTransferMeta
+getFileTransferMeta_ db userId fileId =
   ExceptT . firstRow fileTransferMeta (SEFileNotFound fileId) $
     DB.query
       db
@@ -883,6 +892,20 @@ getContactFileInfo db User {userId} Contact {contactId} =
   map toFileInfo
     <$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ? AND i.contact_id = ?") (userId, contactId)
 
+getLocalCryptoFile :: DB.Connection -> UserId -> Int64 -> Bool -> ExceptT StoreError IO CryptoFile
+getLocalCryptoFile db userId fileId sent =
+  liftIO (getFileTransferRow_ db userId fileId) >>= \case
+    [(Nothing, Just _)] -> do
+      when sent $ throwError $ SEFileNotFound fileId
+      RcvFileTransfer {fileStatus, cryptoArgs} <- getRcvFileTransfer_ db userId fileId
+      case fileStatus of
+        RFSComplete RcvFileInfo {filePath} -> pure $ CryptoFile filePath cryptoArgs
+        _ -> throwError $ SEFileNotFound fileId
+    _ -> do
+      unless sent $ throwError $ SEFileNotFound fileId
+      FileTransferMeta {filePath, xftpSndFile} <- getFileTransferMeta_ db userId fileId
+      pure $ CryptoFile filePath $ xftpSndFile >>= \f -> f.cryptoArgs
+
 updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
 updateDirectCIFileStatus db user fileId fileStatus = do
   aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db user fileId
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 2a3b74da3..9ae00159b 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -14,6 +14,7 @@ module Simplex.Chat.View where
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as JQ
 import qualified Data.ByteString.Char8 as B
+import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (isSpace, toUpper)
 import Data.Function (on)
@@ -76,7 +77,7 @@ serializeChatResponse :: (Maybe RemoteHostId, Maybe User) -> CurrentTime -> Time
 serializeChatResponse user_ ts tz remoteHost_ = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz remoteHost_
 
 responseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> [StyledString]
-responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz outputRH = \case
+responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz outputRH = \case
   CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
   CRUsersList users -> viewUsersList users
   CRChatStarted -> ["chat started"]
@@ -185,10 +186,10 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei
   CRContactUpdated {user = u, fromContact = c, toContact = c'} -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
   CRContactsMerged u intoCt mergedCt ct' -> ttyUser u $ viewContactsMerged intoCt mergedCt ct'
   CRReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> ttyUser u $ viewReceivedContactRequest c profile
-  CRRcvFileStart u ci -> ttyUser u $ receivingFile_' testView "started" ci
-  CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' testView "completed" ci
+  CRRcvFileStart u ci -> ttyUser u $ receivingFile_' hu testView "started" ci
+  CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' hu testView "completed" ci
   CRRcvFileSndCancelled u _ ft -> ttyUser u $ viewRcvFileSndCancelled ft
-  CRRcvFileError u ci e -> ttyUser u $ receivingFile_' testView "error" ci <> [sShow e]
+  CRRcvFileError u ci e -> ttyUser u $ receivingFile_' hu testView "error" ci <> [sShow e]
   CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
   CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
   CRSndFileStartXFTP {} -> []
@@ -272,6 +273,9 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei
   CRRemoteHostList hs -> viewRemoteHosts hs
   CRRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} -> ["remote host " <> sShow rhId <> " connected"]
   CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
+  CRRemoteFileStored rhId (CryptoFile filePath cfArgs_) ->
+    [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]
@@ -1493,18 +1497,25 @@ savingFile' (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileSource
   ["saving file " <> sShow fileId <> fileFrom chat chatDir <> " to " <> plain filePath]
 savingFile' _ = ["saving file"] -- shouldn't happen
 
-receivingFile_' :: Bool -> String -> AChatItem -> [StyledString]
-receivingFile_' testView status (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileName, fileSource = Just (CryptoFile _ cfArgs_)}, chatDir}) =
-  [plain status <> " receiving " <> fileTransferStr fileId fileName <> fileFrom chat chatDir] <> cfArgsStr cfArgs_
+receivingFile_' :: (Maybe RemoteHostId, Maybe User) -> Bool -> String -> AChatItem -> [StyledString]
+receivingFile_' hu testView status (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileName, fileSource = Just f@(CryptoFile _ cfArgs_)}, chatDir}) =
+  [plain status <> " receiving " <> fileTransferStr fileId fileName <> fileFrom chat chatDir] <> cfArgsStr cfArgs_ <> getRemoteFileStr
   where
-    cfArgsStr (Just cfArgs@(CFArgs key nonce)) = [plain s | status == "completed"]
-      where
-      s =
-        if testView
-          then LB.toStrict $ J.encode cfArgs
-          else "encryption key: " <> strEncode key <> ", nonce: " <> strEncode nonce
+    cfArgsStr (Just cfArgs) = [plain (cryptoFileArgsStr testView cfArgs) | status == "completed"]
     cfArgsStr _ = []
-receivingFile_' _ status _ = [plain status <> " receiving file"] -- shouldn't happen
+    getRemoteFileStr = case hu of
+      (Just rhId, Just User {userId}) | status == "completed" ->
+        [ "File received to connected remote host " <> sShow rhId,
+          "To download to this device use:",
+          highlight ("/get remote file " <> show rhId <> " " <> LB.unpack (J.encode RemoteFile {userId, fileId, sent = False, fileSource = f}))
+        ]
+      _ -> []
+receivingFile_' _ _ status _ = [plain status <> " receiving file"] -- shouldn't happen
+
+cryptoFileArgsStr :: Bool -> CryptoFileArgs -> ByteString
+cryptoFileArgsStr testView cfArgs@(CFArgs key nonce)
+  | testView = LB.toStrict $ J.encode cfArgs
+  | otherwise = "encryption key: " <> strEncode key <> ", nonce: " <> strEncode nonce
 
 fileFrom :: ChatInfo c -> CIDirection c d -> StyledString
 fileFrom (DirectChat ct) CIDirectRcv = " from " <> ttyContact' ct
@@ -1818,8 +1829,8 @@ viewChatError logLevel = \case
         Nothing -> ""
       cId :: Connection -> StyledString
       cId conn = sShow conn.connId
-  ChatErrorRemoteCtrl todo'rc -> [sShow todo'rc]
-  ChatErrorRemoteHost remoteHostId todo'rh -> [sShow remoteHostId, sShow todo'rh]
+  ChatErrorRemoteCtrl e -> [plain $ "remote controller error: " <> show e]
+  ChatErrorRemoteHost rhId e -> [plain $ "remote host " <> show rhId <> " error: " <> show e]
   where
     fileNotFound fileId = ["file " <> sShow fileId <> " not found"]
     sqliteError' = \case
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 452f9ca21..be1d3c1a2 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -9,7 +9,9 @@ import ChatClient
 import ChatTests.Utils
 import Control.Logger.Simple
 import Control.Monad
+import qualified Data.Aeson as J
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as M
 import Network.HTTP.Types (ok200)
@@ -17,10 +19,14 @@ import qualified Network.HTTP2.Client as C
 import qualified Network.HTTP2.Server as S
 import qualified Network.Socket as N
 import qualified Network.TLS as TLS
+import Simplex.Chat.Archive (archiveFilesFolder)
+import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..))
 import qualified Simplex.Chat.Controller as Controller
+import Simplex.Chat.Mobile.File
 import Simplex.Chat.Remote.Types
 import qualified Simplex.Chat.Remote.Discovery as Discovery
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
 import Simplex.Messaging.Encoding.String
 import qualified Simplex.Messaging.Transport as Transport
 import Simplex.Messaging.Transport.Client (TransportHost (..))
@@ -28,7 +34,7 @@ import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Response (..), closeHTTP2Client, sendRequest)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
 import Simplex.Messaging.Util
-import System.FilePath (makeRelative, (</>))
+import System.FilePath ((</>))
 import Test.Hspec
 import UnliftIO
 import UnliftIO.Concurrent
@@ -41,7 +47,9 @@ remoteTests = describe "Remote" $ do
   it "performs protocol handshake" remoteHandshakeTest
   it "performs protocol handshake (again)" remoteHandshakeTest -- leaking servers regression check
   it "sends messages" remoteMessageTest
-  xit "sends files" remoteFileTest
+  describe "remote files" $ do
+    it "store/get/send/receive files" remoteStoreFileTest
+    it "should sends files from CLI wihtout /store" remoteCLIFileTest
 
 -- * Low-level TLS with ephemeral credentials
 
@@ -159,32 +167,158 @@ remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
   threadDelay 1000000
   logNote "done"
 
-remoteFileTest :: (HasCallStack) => FilePath -> IO ()
-remoteFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
+remoteStoreFileTest :: HasCallStack => FilePath -> IO ()
+remoteStoreFileTest =
+  testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob ->
+    withXFTPServer $ do
+      let mobileFiles = "./tests/tmp/mobile_files"
+      mobile ##> ("/_files_folder " <> mobileFiles)
+      mobile <## "ok"
+      let desktopFiles = "./tests/tmp/desktop_files"
+      desktop ##> ("/_files_folder " <> desktopFiles)
+      desktop <## "ok"
+      let desktopHostFiles = "./tests/tmp/remote_hosts_data"
+      desktop ##> ("/remote_hosts_folder " <> desktopHostFiles)
+      desktop <## "ok"
+      let bobFiles = "./tests/tmp/bob_files"
+      bob ##> ("/_files_folder " <> bobFiles)
+      bob <## "ok"
+      startRemote mobile desktop
+      contactBob desktop bob
+      rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
+      desktopHostStore <- case M.lookup 1 rhs of
+        Just RemoteHostSession {storePath} -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
+        _ -> fail "Host session 1 should be started"
+      desktop ##> "/store remote file 1 tests/fixtures/test.pdf"
+      desktop <## "file test.pdf stored on remote host 1"
+      src <- B.readFile "tests/fixtures/test.pdf"
+      B.readFile (mobileFiles </> "test.pdf") `shouldReturn` src
+      B.readFile (desktopHostStore </> "test.pdf") `shouldReturn` src
+      desktop ##> "/store remote file 1 tests/fixtures/test.pdf"
+      desktop <## "file test_1.pdf stored on remote host 1"
+      B.readFile (mobileFiles </> "test_1.pdf") `shouldReturn` src
+      B.readFile (desktopHostStore </> "test_1.pdf") `shouldReturn` src
+      desktop ##> "/store remote file 1 encrypt=on tests/fixtures/test.pdf"
+      desktop <## "file test_2.pdf stored on remote host 1"
+      Just cfArgs@(CFArgs key nonce) <- J.decode . LB.pack <$> getTermLine desktop
+      chatReadFile (mobileFiles </> "test_2.pdf") (strEncode key) (strEncode nonce) `shouldReturn` Right (LB.fromStrict src)
+      chatReadFile (desktopHostStore </> "test_2.pdf") (strEncode key) (strEncode nonce) `shouldReturn` Right (LB.fromStrict src)
+
+      removeFile (desktopHostStore </> "test_1.pdf")
+      removeFile (desktopHostStore </> "test_2.pdf")
+
+      -- cannot get file before it is used
+      desktop ##> "/get remote file 1 {\"userId\": 1, \"fileId\": 1, \"sent\": true, \"fileSource\": {\"filePath\": \"test_1.pdf\"}}"
+      hostError desktop "SEFileNotFound"
+      -- send file not encrypted locally on mobile host
+      desktop ##> "/_send @2 json {\"filePath\": \"test_1.pdf\", \"msgContent\": {\"type\": \"file\", \"text\": \"sending a file\"}}"
+      desktop <# "@bob sending a file"
+      desktop <# "/f @bob test_1.pdf" 
+      desktop <## "use /fc 1 to cancel sending"
+      bob <# "alice> sending a file"
+      bob <# "alice> sends file test_1.pdf (266.0 KiB / 272376 bytes)"
+      bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
+      bob ##> "/fr 1"
+      concurrentlyN_
+        [ do
+            desktop <## "completed uploading file 1 (test_1.pdf) for bob",
+          do
+            bob <## "saving file 1 from alice to test_1.pdf"
+            bob <## "started receiving file 1 (test_1.pdf) from alice"
+            bob <## "completed receiving file 1 (test_1.pdf) from alice"
+        ]
+      B.readFile (bobFiles </> "test_1.pdf") `shouldReturn` src
+      -- returns error for inactive user
+      desktop ##> "/get remote file 1 {\"userId\": 2, \"fileId\": 1, \"sent\": true, \"fileSource\": {\"filePath\": \"test_1.pdf\"}}"
+      hostError desktop "CEDifferentActiveUser"
+      -- returns error with incorrect file ID
+      desktop ##> "/get remote file 1 {\"userId\": 1, \"fileId\": 2, \"sent\": true, \"fileSource\": {\"filePath\": \"test_1.pdf\"}}"
+      hostError desktop "SEFileNotFound"
+      -- gets file
+      doesFileExist (desktopHostStore </> "test_1.pdf") `shouldReturn` False
+      desktop ##> "/get remote file 1 {\"userId\": 1, \"fileId\": 1, \"sent\": true, \"fileSource\": {\"filePath\": \"test_1.pdf\"}}"
+      desktop <## "ok"
+      B.readFile (desktopHostStore </> "test_1.pdf") `shouldReturn` src
+
+      -- send file encrypted locally on mobile host
+      desktop ##> ("/_send @2 json {\"fileSource\": {\"filePath\":\"test_2.pdf\", \"cryptoArgs\": " <> LB.unpack (J.encode cfArgs) <> "}, \"msgContent\": {\"type\": \"file\", \"text\": \"\"}}")
+      desktop <# "/f @bob test_2.pdf" 
+      desktop <## "use /fc 2 to cancel sending"
+      bob <# "alice> sends file test_2.pdf (266.0 KiB / 272376 bytes)"
+      bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
+      bob ##> "/fr 2"
+      concurrentlyN_
+        [ do
+            desktop <## "completed uploading file 2 (test_2.pdf) for bob",
+          do
+            bob <## "saving file 2 from alice to test_2.pdf"
+            bob <## "started receiving file 2 (test_2.pdf) from alice"
+            bob <## "completed receiving file 2 (test_2.pdf) from alice"
+        ]
+      B.readFile (bobFiles </> "test_2.pdf") `shouldReturn` src
+
+      -- receive file via remote host
+      copyFile "./tests/fixtures/test.jpg" (bobFiles </> "test.jpg")
+      bob #> "/f @alice test.jpg"
+      bob <## "use /fc 3 to cancel sending"
+      desktop <# "bob> sends file test.jpg (136.5 KiB / 139737 bytes)"
+      desktop <## "use /fr 3 [<dir>/ | <path>] to receive it"
+      desktop ##> "/fr 3 encrypt=on"
+      concurrentlyN_
+        [ do
+            bob <## "completed uploading file 3 (test.jpg) for alice",
+          do
+            desktop <## "saving file 3 from bob to test.jpg"
+            desktop <## "started receiving file 3 (test.jpg) from bob"
+            desktop <## "completed receiving file 3 (test.jpg) from bob"
+        ]
+      Just cfArgs'@(CFArgs key' nonce') <- J.decode . LB.pack <$> getTermLine desktop
+      desktop <## "File received to connected remote host 1"
+      desktop <## "To download to this device use:"
+      getCmd <- getTermLine desktop
+      getCmd `shouldBe` ("/get remote file 1 {\"userId\":1,\"fileId\":3,\"sent\":false,\"fileSource\":{\"filePath\":\"test.jpg\",\"cryptoArgs\":" <> LB.unpack (J.encode cfArgs') <> "}}")
+      src' <- B.readFile (bobFiles </> "test.jpg")
+      chatReadFile (mobileFiles </> "test.jpg") (strEncode key') (strEncode nonce') `shouldReturn` Right (LB.fromStrict src')
+      doesFileExist (desktopHostStore </> "test.jpg") `shouldReturn` False
+      -- returns error with incorrect key
+      desktop ##> "/get remote file 1 {\"userId\": 1, \"fileId\": 3, \"sent\": false, \"fileSource\": {\"filePath\": \"test.jpg\", \"cryptoArgs\": null}}"
+      hostError desktop "SEFileNotFound"
+      doesFileExist (desktopHostStore </> "test.jpg") `shouldReturn` False
+      desktop ##> getCmd
+      desktop <## "ok"
+      chatReadFile (desktopHostStore </> "test.jpg") (strEncode key') (strEncode nonce') `shouldReturn` Right (LB.fromStrict src')
+
+      stopMobile mobile desktop
+  where
+    cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp/tmp"}
+    hostError cc err = do
+      r <- getTermLine cc
+      r `shouldStartWith` "remote host 1 error"
+      r `shouldContain` err
+
+remoteCLIFileTest :: (HasCallStack) => FilePath -> IO ()
+remoteCLIFileTest = testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> withXFTPServer $ do
+  createDirectoryIfMissing True "./tests/tmp/tmp/"
   let mobileFiles = "./tests/tmp/mobile_files"
   mobile ##> ("/_files_folder " <> mobileFiles)
   mobile <## "ok"
-  let desktopFiles = "./tests/tmp/desktop_files"
-  desktop ##> ("/_files_folder " <> desktopFiles)
+  let bobFiles = "./tests/tmp/bob_files/"
+  createDirectoryIfMissing True bobFiles
+  let desktopHostFiles = "./tests/tmp/remote_hosts_data"
+  desktop ##> ("/remote_hosts_folder " <> desktopHostFiles)
   desktop <## "ok"
-  let bobFiles = "./tests/tmp/bob_files"
-  bob ##> ("/_files_folder " <> bobFiles)
-  bob <## "ok"
 
   startRemote mobile desktop
   contactBob desktop bob
 
   rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
-  desktopStore <- case M.lookup 1 rhs of
-    Just RemoteHostSession {storePath} -> pure storePath
+  desktopHostStore <- case M.lookup 1 rhs of
+    Just RemoteHostSession {storePath} -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
     _ -> fail "Host session 1 should be started"
 
-  doesFileExist "./tests/tmp/mobile_files/test.pdf" `shouldReturn` False
-  doesFileExist (desktopFiles </> desktopStore </> "test.pdf") `shouldReturn` False
   mobileName <- userName mobile
 
-  bobsFile <- makeRelative bobFiles <$> makeAbsolute "tests/fixtures/test.pdf"
-  bob #> ("/f @" <> mobileName <> " " <> bobsFile)
+  bob #> ("/f @" <> mobileName <> " " <> "tests/fixtures/test.pdf")
   bob <## "use /fc 1 to cancel sending"
 
   desktop <# "bob> sends file test.pdf (266.0 KiB / 272376 bytes)"
@@ -192,63 +326,47 @@ remoteFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile
   desktop ##> "/fr 1"
   concurrentlyN_
     [ do
-        bob <## "started sending file 1 (test.pdf) to alice"
-        bob <## "completed sending file 1 (test.pdf) to alice",
+        bob <## "completed uploading file 1 (test.pdf) for alice",
       do
         desktop <## "saving file 1 from bob to test.pdf"
         desktop <## "started receiving file 1 (test.pdf) from bob"
+        desktop <## "completed receiving file 1 (test.pdf) from bob"
     ]
-  let desktopReceived = desktopFiles </> desktopStore </> "test.pdf"
-  -- desktop <## ("completed receiving file 1 (" <> desktopReceived <> ") from bob")
-  desktop <## "completed receiving file 1 (test.pdf) from bob"
-  bobsFileSize <- getFileSize bobsFile
-  -- getFileSize desktopReceived `shouldReturn` bobsFileSize
-  bobsFileBytes <- B.readFile bobsFile
-  -- B.readFile desktopReceived `shouldReturn` bobsFileBytes
 
-  -- test file transit on mobile
-  mobile ##> "/fs 1"
-  mobile <## "receiving file 1 (test.pdf) complete, path: test.pdf"
-  getFileSize (mobileFiles </> "test.pdf") `shouldReturn` bobsFileSize
-  B.readFile (mobileFiles </> "test.pdf") `shouldReturn` bobsFileBytes
+  desktop <## "File received to connected remote host 1"
+  desktop <## "To download to this device use:"
+  getCmd <- getTermLine desktop
+  src <- B.readFile "tests/fixtures/test.pdf"
+  B.readFile (mobileFiles </> "test.pdf") `shouldReturn` src
+  doesFileExist (desktopHostStore </> "test.pdf") `shouldReturn` False
+  desktop ##> getCmd
+  desktop <## "ok"
+  B.readFile (desktopHostStore </> "test.pdf") `shouldReturn` src
 
-  logNote "file received"
-
-  desktopFile <- makeRelative desktopFiles <$> makeAbsolute "tests/fixtures/logo.jpg" -- XXX: not necessary for _send, but required for /f
-  logNote $ "sending " <> tshow desktopFile
-  doesFileExist (bobFiles </> "logo.jpg") `shouldReturn` False
-  doesFileExist (mobileFiles </> "logo.jpg") `shouldReturn` False
-  desktop ##> "/_send @2 json {\"filePath\": \"./tests/fixtures/logo.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"hi, sending a file\"}}"
-  desktop <# "@bob hi, sending a file"
-  desktop <# "/f @bob logo.jpg"
+  desktop `send` "/f @bob tests/fixtures/test.jpg"
+  desktop <# "/f @bob test.jpg"
   desktop <## "use /fc 2 to cancel sending"
 
-  bob <# "alice> hi, sending a file"
-  bob <# "alice> sends file logo.jpg (31.3 KiB / 32080 bytes)"
+  bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
   bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
-  bob ##> "/fr 2"
+  bob ##> ("/fr 2 " <> bobFiles)
   concurrentlyN_
     [ do
-        bob <## "saving file 2 from alice to logo.jpg"
-        bob <## "started receiving file 2 (logo.jpg) from alice"
-        bob <## "completed receiving file 2 (logo.jpg) from alice"
-        bob ##> "/fs 2"
-        bob <## "receiving file 2 (logo.jpg) complete, path: logo.jpg",
+        desktop <## "completed uploading file 2 (test.jpg) for bob",
       do
-        desktop <## "started sending file 2 (logo.jpg) to bob"
-        desktop <## "completed sending file 2 (logo.jpg) to bob"
+        bob <## "saving file 2 from alice to ./tests/tmp/bob_files/test.jpg"
+        bob <## "started receiving file 2 (test.jpg) from alice"
+        bob <## "completed receiving file 2 (test.jpg) from alice"
     ]
-  desktopFileSize <- getFileSize desktopFile
-  getFileSize (bobFiles </> "logo.jpg") `shouldReturn` desktopFileSize
-  getFileSize (mobileFiles </> "logo.jpg") `shouldReturn` desktopFileSize
 
-  desktopFileBytes <- B.readFile desktopFile
-  B.readFile (bobFiles </> "logo.jpg") `shouldReturn` desktopFileBytes
-  B.readFile (mobileFiles </> "logo.jpg") `shouldReturn` desktopFileBytes
-
-  logNote "file sent"
+  src' <- B.readFile "tests/fixtures/test.jpg"
+  B.readFile (mobileFiles </> "test.jpg") `shouldReturn` src'
+  B.readFile (desktopHostStore </> "test.jpg") `shouldReturn` src'
+  B.readFile (bobFiles </> "test.jpg") `shouldReturn` src'
 
   stopMobile mobile desktop
+  where
+    cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp/tmp"}
 
 -- * Utils
 

From be44632b0bc71df56d034d16ffdce0b41dedd171 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Mon, 30 Oct 2023 16:00:54 +0200
Subject: [PATCH 25/69] implement some of the robust discovery rfc (#3283)

* implement robust discovery

* remove qualified

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 src/Simplex/Chat.hs                   |   6 +-
 src/Simplex/Chat/Controller.hs        |  11 +-
 src/Simplex/Chat/Remote.hs            |  88 ++++++------
 src/Simplex/Chat/Remote/Discovery.hs  | 196 +++++++++++++++++---------
 src/Simplex/Chat/Remote/Multicast.hsc |   9 +-
 src/Simplex/Chat/Remote/Protocol.hs   |   4 +-
 src/Simplex/Chat/Remote/Types.hs      | 181 +++++++++++++++++++++++-
 src/Simplex/Chat/Store/Remote.hs      |  10 +-
 src/Simplex/Chat/View.hs              |   9 +-
 tests/RemoteTests.hs                  |  66 ++++++---
 10 files changed, 430 insertions(+), 150 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index e46a426d8..383e045f8 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -213,6 +213,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
   rcvFiles <- newTVarIO M.empty
   currentCalls <- atomically TM.empty
   localDeviceName <- newTVarIO "" -- TODO set in config
+  multicastSubscribers <- newTMVarIO 0
   remoteHostSessions <- atomically TM.empty
   remoteHostsFolder <- newTVarIO Nothing
   remoteCtrlSession <- newTVarIO Nothing
@@ -247,6 +248,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
         rcvFiles,
         currentCalls,
         localDeviceName,
+        multicastSubscribers,
         remoteHostSessions,
         remoteHostsFolder,
         remoteCtrlSession,
@@ -5861,8 +5863,8 @@ chatCommandP =
       "/store remote file " *> (StoreRemoteFile <$> A.decimal <*> optional (" encrypt=" *> onOffP) <* A.space <*> filePath),
       "/get remote file " *> (GetRemoteFile <$> A.decimal <* A.space <*> jsonP),
       "/start remote ctrl" $> StartRemoteCtrl,
-      "/register remote ctrl " *> (RegisterRemoteCtrl <$> (RemoteCtrlOOB <$> strP <* A.space <*> textP)),
-      "/_register remote ctrl " *> (RegisterRemoteCtrl <$> jsonP),
+      "/register remote ctrl " *> (RegisterRemoteCtrl <$> strP),
+      -- "/_register remote ctrl " *> (RegisterRemoteCtrl <$> jsonP),
       "/list remote ctrls" $> ListRemoteCtrls,
       "/accept remote ctrl " *> (AcceptRemoteCtrl <$> A.decimal),
       "/reject remote ctrl " *> (RejectRemoteCtrl <$> A.decimal),
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index bc4cfaaf8..19e8dc34d 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -25,7 +25,7 @@ import Control.Monad.Reader
 import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?))
 import qualified Data.Aeson as J
-import qualified Data.Aeson.TH  as JQ
+import qualified Data.Aeson.TH as JQ
 import qualified Data.Aeson.Types as JT
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
@@ -40,6 +40,7 @@ import Data.String
 import Data.Text (Text)
 import Data.Time (NominalDiffTime, UTCTime)
 import Data.Version (showVersion)
+import Data.Word (Word16)
 import Language.Haskell.TH (Exp, Q, runIO)
 import Numeric.Natural
 import qualified Paths_simplex_chat as SC
@@ -177,6 +178,7 @@ data ChatController = ChatController
     rcvFiles :: TVar (Map Int64 Handle),
     currentCalls :: TMap ContactId Call,
     localDeviceName :: TVar Text,
+    multicastSubscribers :: TMVar Int,
     remoteHostSessions :: TMap RemoteHostId RemoteHostSession, -- All the active remote hosts
     remoteHostsFolder :: TVar (Maybe FilePath), -- folder for remote hosts data
     remoteCtrlSession :: TVar (Maybe RemoteCtrlSession), -- Supervisor process for hosted controllers
@@ -424,12 +426,12 @@ data ChatCommand
   | StoreRemoteFile {remoteHostId :: RemoteHostId, storeEncrypted :: Maybe Bool, localPath :: FilePath}
   | GetRemoteFile {remoteHostId :: RemoteHostId, file :: RemoteFile}
   | StartRemoteCtrl -- ^ Start listening for announcements from all registered controllers
-  | RegisterRemoteCtrl RemoteCtrlOOB -- ^ Register OOB data for satellite discovery and handshake
+  | RegisterRemoteCtrl SignedOOB -- ^ Register OOB data for remote controller discovery and handshake
   | ListRemoteCtrls
   | AcceptRemoteCtrl RemoteCtrlId -- ^ Accept discovered data and store confirmation
   | RejectRemoteCtrl RemoteCtrlId -- ^ Reject and blacklist discovered data
   | StopRemoteCtrl -- ^ Stop listening for announcements or terminate an active session
-  | DeleteRemoteCtrl RemoteCtrlId -- ^ Remove all local data associated with a satellite session
+  | DeleteRemoteCtrl RemoteCtrlId -- ^ Remove all local data associated with a remote controller session
   | QuitChat
   | ShowVersion
   | DebugLocks
@@ -634,6 +636,7 @@ data ChatResponse
   | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
   | CRRemoteHostCreated {remoteHost :: RemoteHostInfo}
   | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
+  | CRRemoteHostStarted {remoteHost :: RemoteHostInfo, sessionOOB :: Text}
   | CRRemoteHostConnected {remoteHost :: RemoteHostInfo}
   | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
   | CRRemoteFileStored {remoteHostId :: RemoteHostId, remoteFileSource :: CryptoFile}
@@ -1069,7 +1072,7 @@ data RemoteCtrlSession = RemoteCtrlSession
     discoverer :: Async (),
     supervisor :: Async (),
     hostServer :: Maybe (Async ()),
-    discovered :: TMap C.KeyHash TransportHost,
+    discovered :: TMap C.KeyHash (TransportHost, Word16),
     accepted :: TMVar RemoteCtrlId,
     remoteOutputQ :: TBQueue ChatResponse
   }
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 5344c4bea..d6ccd2596 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -12,6 +12,7 @@
 
 module Simplex.Chat.Remote where
 
+import Control.Applicative ((<|>))
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
@@ -24,15 +25,16 @@ import Data.ByteString (ByteString)
 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 (encodeUtf8)
-import Data.Word (Word32)
-import Network.HTTP2.Server (responseStreaming)
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Data.Word (Word16, Word32)
 import qualified Network.HTTP.Types as N
+import Network.HTTP2.Server (responseStreaming)
 import Network.Socket (SockAddr (..), hostAddressToTuple)
 import Simplex.Chat.Archive (archiveFilesFolder)
 import Simplex.Chat.Controller
@@ -51,18 +53,17 @@ import Simplex.FileTransfer.Description (FileDigest (..))
 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 (smpDecode)
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
-import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (ifM, liftEitherError, liftEitherWith, liftError, liftIOEither, tryAllErrors, tshow, ($>>=), (<$$>))
-import System.FilePath ((</>), takeFileName)
+import System.FilePath (takeFileName, (</>))
 import UnliftIO
 import UnliftIO.Directory (copyFile, createDirectoryIfMissing, renameFile)
-import Data.Functor (($>))
-import Control.Applicative ((<|>))
 
 -- * Desktop side
 
@@ -108,11 +109,14 @@ startRemoteHost rhId = do
         toView (CRRemoteHostStopped rhId) -- only signal "stopped" when the session is unregistered cleanly
       -- block until some client is connected or an error happens
       logInfo $ "Remote host session connecting for " <> tshow rhId
-      httpClient <- liftEitherError (ChatErrorRemoteCtrl . RCEHTTP2Error . show) $ Discovery.announceRevHTTP2 tasks fingerprint credentials cleanupIO
-      logInfo $ "Remote host session connected for " <> tshow rhId
       rcName <- chatReadVar localDeviceName
+      localAddr <- asks multicastSubscribers >>= Discovery.getLocalAddress >>= maybe (throwError . ChatError $ CEInternalError "unable to get local address") pure
+      (dhKey, sigKey, ann, oob) <- Discovery.startSession (if rcName == "" then Nothing else Just rcName) (localAddr, read Discovery.DISCOVERY_PORT) fingerprint
+      toView CRRemoteHostStarted {remoteHost = remoteHostInfo rh True, sessionOOB = decodeUtf8 $ strEncode oob}
+      httpClient <- liftEitherError (ChatErrorRemoteCtrl . RCEHTTP2Error . show) $ Discovery.announceRevHTTP2 tasks (sigKey, ann) credentials cleanupIO
+      logInfo $ "Remote host session connected for " <> tshow rhId
       -- test connection and establish a protocol layer
-      remoteHostClient <- liftRH rhId $ createRemoteHostClient httpClient rcName
+      remoteHostClient <- liftRH rhId $ createRemoteHostClient httpClient dhKey rcName
       -- set up message polling
       oq <- asks outputQ
       asyncRegistered tasks . forever $ do
@@ -125,7 +129,6 @@ startRemoteHost rhId = do
         { remoteHostId = rhId,
           storePath = storePath,
           displayName = hostDeviceName remoteHostClient,
-          remoteCtrlOOB = RemoteCtrlOOB {fingerprint, displayName=rcName},
           sessionActive = True
         }
 
@@ -159,10 +162,9 @@ createRemoteHost = do
   ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) "Host"
   storePath <- liftIO randomStorePath
   let remoteName = "" -- will be passed from remote host in hello
-  remoteHostId <- withStore' $ \db -> insertRemoteHost db storePath remoteName caKey caCert
-  localName <- chatReadVar localDeviceName
-  let remoteCtrlOOB = RemoteCtrlOOB {fingerprint = C.certificateFingerprint caCert, displayName = localName}
-  pure RemoteHostInfo {remoteHostId, storePath, displayName = remoteName, remoteCtrlOOB, sessionActive = False}
+  rhId <- withStore' $ \db -> insertRemoteHost db storePath remoteName caKey caCert
+  rh <- withStore $ \db -> getRemoteHost db rhId
+  pure $ remoteHostInfo rh False
 
 -- | Generate a random 16-char filepath without / in it by using base64url encoding.
 randomStorePath :: IO FilePath
@@ -171,16 +173,14 @@ randomStorePath = B.unpack . B64U.encode <$> getRandomBytes 12
 listRemoteHosts :: ChatMonad m => m [RemoteHostInfo]
 listRemoteHosts = do
   active <- chatReadVar remoteHostSessions
-  rcName <- chatReadVar localDeviceName
-  map (rhInfo active rcName) <$> withStore' getRemoteHosts
+  map (rhInfo active) <$> withStore' getRemoteHosts
   where
-    rhInfo active rcName rh@RemoteHost {remoteHostId} =
-      remoteHostInfo rh (M.member remoteHostId active) rcName
+    rhInfo active rh@RemoteHost {remoteHostId} =
+      remoteHostInfo rh (M.member remoteHostId active)
 
-remoteHostInfo :: RemoteHost -> Bool -> Text -> RemoteHostInfo
-remoteHostInfo RemoteHost {remoteHostId, storePath, displayName, caCert} sessionActive rcName =
-  let remoteCtrlOOB = RemoteCtrlOOB {fingerprint = C.certificateFingerprint caCert, displayName = rcName}
-   in RemoteHostInfo {remoteHostId, storePath, displayName, remoteCtrlOOB, sessionActive}
+remoteHostInfo :: RemoteHost -> Bool -> RemoteHostInfo
+remoteHostInfo RemoteHost {remoteHostId, storePath, displayName} sessionActive =
+  RemoteHostInfo {remoteHostId, storePath, displayName, sessionActive}
 
 deleteRemoteHost :: ChatMonad m => RemoteHostId -> m ()
 deleteRemoteHost rhId = do
@@ -231,7 +231,7 @@ getRemoteFile rhId rf = do
 processRemoteCommand :: ChatMonad m => RemoteHostId -> RemoteHostSession -> ChatCommand -> ByteString -> m ChatResponse
 processRemoteCommand remoteHostId RemoteHostSession {remoteHostClient = Just rhc} cmd s = case cmd of
   SendFile chatName f -> sendFile "/f" chatName f
-  SendImage chatName f -> sendFile "/img" chatName f    
+  SendImage chatName f -> sendFile "/img" chatName f
   _ -> liftRH remoteHostId $ remoteSend rhc s
   where
     sendFile cmdName chatName (CryptoFile path cfArgs) = do
@@ -262,14 +262,14 @@ startRemoteCtrl execChatCommand = do
   chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted, remoteOutputQ}
 
 -- | Track remote host lifecycle in controller session state and signal UI on its progress
-runHost :: ChatMonad m => TM.TMap C.KeyHash TransportHost -> TMVar RemoteCtrlId -> (HTTP2Request -> m ()) -> m ()
+runHost :: ChatMonad m => TM.TMap C.KeyHash (TransportHost, Word16) -> TMVar RemoteCtrlId -> (HTTP2Request -> m ()) -> m ()
 runHost discovered accepted handleHttp = do
   remoteCtrlId <- atomically (readTMVar accepted) -- wait for ???
   rc@RemoteCtrl {fingerprint} <- withStore (`getRemoteCtrl` remoteCtrlId)
-  source <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure -- wait for location of the matching fingerprint
+  serviceAddress <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure -- wait for location of the matching fingerprint
   toView $ CRRemoteCtrlConnecting $ remoteCtrlInfo rc False
   atomically $ writeTVar discovered mempty -- flush unused sources
-  server <- async $ Discovery.connectRevHTTP2 source fingerprint handleHttp -- spawn server for remote protocol commands
+  server <- async $ Discovery.connectRevHTTP2 serviceAddress fingerprint handleHttp -- spawn server for remote protocol commands
   chatModifyVar remoteCtrlSession $ fmap $ \s -> s {hostServer = Just server}
   toView $ CRRemoteCtrlConnected $ remoteCtrlInfo rc True
   _ <- waitCatch server -- wait for the server to finish
@@ -369,34 +369,38 @@ handleGetFile User {userId} RemoteFile{userId = commandUserId, fileId, sent, fil
       withFile path ReadMode $ \h ->
         reply RRFile {fileSize, fileDigest} $ \send -> hSendFile h send fileSize
 
-discoverRemoteCtrls :: ChatMonad m => TM.TMap C.KeyHash TransportHost -> m ()
-discoverRemoteCtrls discovered = Discovery.withListener $ receive >=> process
+discoverRemoteCtrls :: ChatMonad m => TM.TMap C.KeyHash (TransportHost, Word16) -> m ()
+discoverRemoteCtrls discovered = do
+  subscribers <- asks multicastSubscribers
+  Discovery.withListener subscribers run
   where
-    -- TODO how would it receive more than one fingerprint?
+    run sock = receive sock >>= process sock
+
     receive sock =
       Discovery.recvAnnounce sock >>= \case
-        (SockAddrInet _sockPort sockAddr, invite) -> case strDecode invite of
-          -- TODO it is probably better to report errors to view here
-          Left _ -> receive sock
-          Right fingerprint -> pure (sockAddr, fingerprint)
+        (SockAddrInet _sockPort sockAddr, sigAnnBytes) -> case smpDecode sigAnnBytes of
+          Right (SignedAnnounce ann _sig) -> pure (sockAddr, ann)
+          Left _ -> receive sock -- TODO it is probably better to report errors to view here
         _nonV4 -> receive sock
-    process (sockAddr, fingerprint) = do
+
+    process sock (sockAddr, Announce {caFingerprint, serviceAddress=(annAddr, port)}) = do
+      unless (annAddr == sockAddr) $ logError "Announced address doesn't match socket address"
       let addr = THIPv4 (hostAddressToTuple sockAddr)
       ifM
-        (atomically $ TM.member fingerprint discovered)
-        (logDebug $ "Fingerprint already known: " <> tshow (addr, fingerprint))
+        (atomically $ TM.member caFingerprint discovered)
+        (logDebug $ "Fingerprint already known: " <> tshow (addr, caFingerprint))
         ( do
-            logInfo $ "New fingerprint announced: " <> tshow (addr, fingerprint)
-            atomically $ TM.insert fingerprint addr discovered
+            logInfo $ "New fingerprint announced: " <> tshow (addr, caFingerprint)
+            atomically $ TM.insert caFingerprint (addr, port) discovered
         )
       -- TODO we check fingerprint for duplicate where id doesn't matter - to prevent re-insert - and don't check to prevent duplicate events,
       -- so UI now will have to check for duplicates again
-      withStore' (`getRemoteCtrlByFingerprint` fingerprint) >>= \case
-        Nothing -> toView $ CRRemoteCtrlAnnounce fingerprint -- unknown controller, ui "register" action required
+      withStore' (`getRemoteCtrlByFingerprint` caFingerprint) >>= \case
+        Nothing -> toView $ CRRemoteCtrlAnnounce caFingerprint -- unknown controller, ui "register" action required
         -- TODO Maybe Bool is very confusing - the intent is very unclear here
         Just found@RemoteCtrl {remoteCtrlId, accepted = storedChoice} -> case storedChoice of
           Nothing -> toView $ CRRemoteCtrlFound $ remoteCtrlInfo found False -- first-time controller, ui "accept" action required
-          Just False -> pure () -- skipping a rejected item
+          Just False -> run sock -- restart, skipping a rejected item
           Just True ->
             chatReadVar remoteCtrlSession >>= \case
               Nothing -> toView . CRChatError Nothing . ChatError $ CEInternalError "Remote host found without running a session"
diff --git a/src/Simplex/Chat/Remote/Discovery.hs b/src/Simplex/Chat/Remote/Discovery.hs
index babc65e6a..1ede108b0 100644
--- a/src/Simplex/Chat/Remote/Discovery.hs
+++ b/src/Simplex/Chat/Remote/Discovery.hs
@@ -1,37 +1,33 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 
-module Simplex.Chat.Remote.Discovery
-  ( -- * Announce
-    announceRevHTTP2,
-    runAnnouncer,
-    startTLSServer,
-    runHTTP2Client,
-
-    -- * Discovery
-    connectRevHTTP2,
-    withListener,
-    openListener,
-    recvAnnounce,
-    connectTLSClient,
-    attachHTTP2Server,
-  )
-where
+module Simplex.Chat.Remote.Discovery where
 
 import Control.Logger.Simple
 import Control.Monad
+import Crypto.Random (getRandomBytes)
 import Data.ByteString (ByteString)
+import qualified Data.ByteString.Base64.URL as B64U
 import Data.Default (def)
 import Data.String (IsString)
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8)
+import Data.Time.Clock.System (getSystemTime)
+import Data.Word (Word16)
 import qualified Network.Socket as N
 import qualified Network.TLS as TLS
 import qualified Network.UDP as UDP
 import Simplex.Chat.Remote.Multicast (setMembership)
-import Simplex.Chat.Remote.Types (Tasks, registerAsync)
+import Simplex.Chat.Remote.Types
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding (Encoding (..))
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Transport (supportedParameters)
 import qualified Simplex.Messaging.Transport as Transport
@@ -39,8 +35,9 @@ import Simplex.Messaging.Transport.Client (TransportHost (..), defaultTransportC
 import Simplex.Messaging.Transport.HTTP2 (defaultHTTP2BufferSize, getHTTP2Body)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError (..), attachHTTP2Client, bodyHeadSize, connTimeout, defaultHTTP2ClientConfig)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..), runHTTP2ServerWith)
-import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTransportServer)
-import Simplex.Messaging.Util (ifM, tshow, whenM)
+import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTransportServerSocket, startTCPServer)
+import Simplex.Messaging.Util (ifM, tshow)
+import Simplex.Messaging.Version (mkVersionRange)
 import UnliftIO
 import UnliftIO.Concurrent
 
@@ -52,54 +49,107 @@ pattern ANY_ADDR_V4 :: (IsString a, Eq a) => a
 pattern ANY_ADDR_V4 = "0.0.0.0"
 
 pattern DISCOVERY_PORT :: (IsString a, Eq a) => a
-pattern DISCOVERY_PORT = "5226"
+pattern DISCOVERY_PORT = "5227"
+
+startSession :: MonadIO m => Maybe Text -> (N.HostAddress, Word16) -> C.KeyHash -> m ((C.APublicDhKey, C.APrivateDhKey), C.PrivateKeyEd25519, Announce, SignedOOB)
+startSession deviceName serviceAddress caFingerprint = liftIO $ do
+  sessionStart <- getSystemTime
+  dh@(C.APublicDhKey C.SX25519 sessionDH, _) <- C.generateDhKeyPair C.SX25519
+  (C.APublicVerifyKey C.SEd25519 sigPubKey, C.APrivateSignKey C.SEd25519 sigSecretKey) <- C.generateSignatureKeyPair C.SEd25519
+  let
+    announce =
+      Announce
+        { versionRange = announceVersionRange,
+          sessionStart,
+          announceCounter = 0,
+          serviceAddress,
+          caFingerprint,
+          sessionDH,
+          announceKey = sigPubKey
+        }
+  authToken <- decodeUtf8 . B64U.encode <$> getRandomBytes 12
+  let
+    oob =
+      OOB
+        { caFingerprint,
+          authToken,
+          host = decodeUtf8 . strEncode $ THIPv4 . N.hostAddressToTuple $ fst serviceAddress,
+          port = snd serviceAddress,
+          version = mkVersionRange 1 1,
+          appName = "simplex-chat",
+          sigPubKey,
+          deviceName
+        }
+  pure (dh, sigSecretKey, announce, signOOB sigSecretKey oob)
+
+getLocalAddress :: MonadIO m => TMVar Int -> m (Maybe N.HostAddress)
+getLocalAddress subscribers = liftIO $ do
+  probe <- mkIpProbe
+  let bytes = smpEncode probe
+  withListener subscribers $ \receiver ->
+    withSender $ \sender -> do
+      UDP.send sender bytes
+      let expect = do
+            UDP.recvFrom receiver >>= \case
+              (p, _) | p /= bytes -> expect
+              (_, UDP.ClientSockAddr (N.SockAddrInet _port host) _cmsg) -> pure host
+              (_, UDP.ClientSockAddr _badAddr _) -> error "receiving from IPv4 socket"
+      timeout 1000000 expect
+
+mkIpProbe :: MonadIO m => m IpProbe
+mkIpProbe = do
+  randomNonce <- liftIO $ getRandomBytes 32
+  pure IpProbe {versionRange = ipProbeVersionRange, randomNonce}
 
 -- | Announce tls server, wait for connection and attach http2 client to it.
 --
 -- Announcer is started when TLS server is started and stopped when a connection is made.
-announceRevHTTP2 :: StrEncoding a => Tasks -> a -> TLS.Credentials -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
-announceRevHTTP2 tasks invite credentials finishAction = do
+announceRevHTTP2 :: Tasks -> (C.PrivateKeyEd25519, Announce) -> TLS.Credentials -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
+announceRevHTTP2 tasks (sigKey, announce@Announce {caFingerprint, serviceAddress=(host, _port)}) credentials finishAction = do
   httpClient <- newEmptyMVar
   started <- newEmptyTMVarIO
   finished <- newEmptyMVar
   _ <- forkIO $ readMVar finished >> finishAction -- attach external cleanup action to session lock
-  announcer <- async . liftIO . whenM (atomically $ takeTMVar started) $ do
-    logInfo $ "Starting announcer for " <> tshow (strEncode invite)
-    runAnnouncer (strEncode invite)
+  announcer <- async . liftIO $ atomically (takeTMVar started) >>= \case
+    Nothing -> pure () -- TLS server failed to start, skipping announcer
+    Just givenPort -> do
+      logInfo $ "Starting announcer for " <> ident <> " at " <> tshow (host, givenPort)
+      runAnnouncer (sigKey, announce {serviceAddress = (host, fromIntegral givenPort)})
   tasks `registerAsync` announcer
   tlsServer <- startTLSServer started credentials $ \tls -> do
-    logInfo $ "Incoming connection for " <> tshow (strEncode invite)
+    logInfo $ "Incoming connection for " <> ident
     cancel announcer
     runHTTP2Client finished httpClient tls `catchAny` (logError . tshow)
-    logInfo $ "Client finished for " <> tshow (strEncode invite)
-  -- BUG: this should be handled in HTTP2Client wrapper
-  _ <- forkIO $ do
-    waitCatch tlsServer >>= \case
-      Left err | fromException err == Just AsyncCancelled -> logDebug "tlsServer cancelled"
-      Left err -> do
-        logError $ "tlsServer failed to start: " <> tshow err
-        void $ tryPutMVar httpClient $ Left HCNetworkError
-        void . atomically $ tryPutTMVar started False
-      Right () -> pure ()
-    void $ tryPutMVar finished ()
+    logInfo $ "Client finished for " <> ident
+  -- BUG: this should be handled in HTTP2Client wrapper, partially handled in startTLSServer
+  _ <- forkIO $ waitCatch tlsServer >> void (tryPutMVar finished ())
   tasks `registerAsync` tlsServer
-  logInfo $ "Waiting for client for " <> tshow (strEncode invite)
+  logInfo $ "Waiting for client for " <> ident
   readMVar httpClient
+  where
+    ident = decodeUtf8 $ strEncode caFingerprint
 
--- | Broadcast invite with link-local datagrams
-runAnnouncer :: ByteString -> IO ()
-runAnnouncer inviteBS = do
-  bracket (UDP.clientSocket MULTICAST_ADDR_V4 DISCOVERY_PORT False) UDP.close $ \sock -> do
-    let raw = UDP.udpSocket sock
-    N.setSocketOption raw N.Broadcast 1
-    N.setSocketOption raw N.ReuseAddr 1
-    forever $ do
-      UDP.send sock inviteBS
+-- | Send replay-proof announce datagrams
+runAnnouncer :: (C.PrivateKeyEd25519, Announce) -> IO ()
+runAnnouncer (announceKey, initialAnnounce) = withSender $ loop initialAnnounce
+  where
+    loop announce sock = do
+      UDP.send sock $ smpEncode (signAnnounce announceKey announce)
       threadDelay 1000000
+      loop announce {announceCounter = announceCounter announce + 1} sock
 
--- XXX: Do we need to start multiple TLS servers for different mobile hosts?
-startTLSServer :: (MonadUnliftIO m) => TMVar Bool -> TLS.Credentials -> (Transport.TLS -> IO ()) -> m (Async ())
-startTLSServer started credentials = async . liftIO . runTransportServer started DISCOVERY_PORT serverParams defaultTransportServerConfig
+startTLSServer :: (MonadUnliftIO m) => TMVar (Maybe N.PortNumber) -> TLS.Credentials -> (Transport.TLS -> IO ()) -> m (Async ())
+startTLSServer started credentials server = async . liftIO $ do
+  startedOk <- newEmptyTMVarIO
+  bracketOnError (startTCPServer startedOk "0") (\_e -> void . atomically $ tryPutTMVar started Nothing) $ \socket ->
+    ifM
+      (atomically $ readTMVar startedOk)
+      do
+        port <- N.socketPort socket
+        logInfo $ "System-assigned port: " <> tshow port
+        atomically $ putTMVar started (Just port)
+        runTransportServerSocket startedOk (pure socket) "RCP TLS" serverParams defaultTransportServerConfig server
+      (void . atomically $ tryPutTMVar started Nothing)
   where
     serverParams =
       def
@@ -123,22 +173,40 @@ runHTTP2Client finishedVar clientVar tls =
     -- TODO connection timeout
     config = defaultHTTP2ClientConfig {bodyHeadSize = doNotPrefetchHead, connTimeout = maxBound}
 
-withListener :: (MonadUnliftIO m) => (UDP.ListenSocket -> m a) -> m a
-withListener = bracket openListener closeListener
+withSender :: MonadUnliftIO m => (UDP.UDPSocket -> m a) -> m a
+withSender = bracket (liftIO $ UDP.clientSocket MULTICAST_ADDR_V4 DISCOVERY_PORT False) (liftIO . UDP.close)
 
-openListener :: (MonadIO m) => m UDP.ListenSocket
-openListener = liftIO $ do
+withListener :: MonadUnliftIO m => TMVar Int -> (UDP.ListenSocket -> m a) -> m a
+withListener subscribers = bracket (openListener subscribers) (closeListener subscribers)
+
+openListener :: MonadIO m => TMVar Int -> m UDP.ListenSocket
+openListener subscribers = liftIO $ do
   sock <- UDP.serverSocket (MULTICAST_ADDR_V4, read DISCOVERY_PORT)
   logDebug $ "Discovery listener socket: " <> tshow sock
   let raw = UDP.listenSocket sock
-  N.setSocketOption raw N.Broadcast 1
-  void $ setMembership raw (listenerHostAddr4 sock) True
+  -- N.setSocketOption raw N.Broadcast 1
+  joinMulticast subscribers raw (listenerHostAddr4 sock)
   pure sock
 
-closeListener :: MonadIO m => UDP.ListenSocket -> m ()
-closeListener sock = liftIO $ do
-  UDP.stop sock
-  void $ setMembership (UDP.listenSocket sock) (listenerHostAddr4 sock) False
+closeListener :: MonadIO m => TMVar Int -> UDP.ListenSocket -> m ()
+closeListener subscribers sock = liftIO $
+  partMulticast subscribers (UDP.listenSocket sock) (listenerHostAddr4 sock) `finally` UDP.stop sock
+
+joinMulticast :: TMVar Int -> N.Socket -> N.HostAddress -> IO ()
+joinMulticast subscribers sock group = do
+  now <- atomically $ takeTMVar subscribers
+  when (now == 0) $ do
+    setMembership sock group True >>= \case
+      Left e -> atomically (putTMVar subscribers now) >> logError ("setMembership failed " <> tshow e)
+      Right () -> atomically $ putTMVar subscribers (now + 1)
+
+partMulticast :: TMVar Int -> N.Socket -> N.HostAddress -> IO ()
+partMulticast subscribers sock group = do
+  now <- atomically $ takeTMVar subscribers
+  when (now == 1) $
+    setMembership sock group False >>= \case
+      Left e -> atomically (putTMVar subscribers now) >> logError ("setMembership failed " <> tshow e)
+      Right () -> atomically $ putTMVar subscribers (now - 1)
 
 listenerHostAddr4 :: UDP.ListenSocket -> N.HostAddress
 listenerHostAddr4 sock = case UDP.mySockAddr sock of
@@ -150,11 +218,11 @@ recvAnnounce sock = liftIO $ do
   (invite, UDP.ClientSockAddr source _cmsg) <- UDP.recvFrom sock
   pure (source, invite)
 
-connectRevHTTP2 :: (MonadUnliftIO m) => TransportHost -> C.KeyHash -> (HTTP2Request -> m ()) -> m ()
-connectRevHTTP2 host fingerprint = connectTLSClient host fingerprint . attachHTTP2Server
+connectRevHTTP2 :: (MonadUnliftIO m) => (TransportHost, Word16) -> C.KeyHash -> (HTTP2Request -> m ()) -> m ()
+connectRevHTTP2 serviceAddress fingerprint = connectTLSClient serviceAddress fingerprint . attachHTTP2Server
 
-connectTLSClient :: (MonadUnliftIO m) => TransportHost -> C.KeyHash -> (Transport.TLS -> m a) -> m a
-connectTLSClient host caFingerprint = runTransportClient defaultTransportClientConfig Nothing host DISCOVERY_PORT (Just caFingerprint)
+connectTLSClient :: (MonadUnliftIO m) => (TransportHost, Word16) -> C.KeyHash -> (Transport.TLS -> m a) -> m a
+connectTLSClient (host, port) caFingerprint = runTransportClient defaultTransportClientConfig Nothing host (show port) (Just caFingerprint)
 
 attachHTTP2Server :: (MonadUnliftIO m) => (HTTP2Request -> m ()) -> Transport.TLS -> m ()
 attachHTTP2Server processRequest tls = do
diff --git a/src/Simplex/Chat/Remote/Multicast.hsc b/src/Simplex/Chat/Remote/Multicast.hsc
index ea015c18e..3919b4423 100644
--- a/src/Simplex/Chat/Remote/Multicast.hsc
+++ b/src/Simplex/Chat/Remote/Multicast.hsc
@@ -10,12 +10,15 @@ import Network.Socket
 
 NB: Group membership is per-host, not per-process. A socket is only used to access system interface for groups.
 -}
-setMembership :: Socket -> HostAddress -> Bool -> IO Bool
+setMembership :: Socket -> HostAddress -> Bool -> IO (Either CInt ())
 setMembership sock group membership = allocaBytes #{size struct ip_mreq} $ \mReqPtr -> do
   #{poke struct ip_mreq, imr_multiaddr} mReqPtr group
   #{poke struct ip_mreq, imr_interface} mReqPtr (0 :: HostAddress) -- attempt to contact the group on ANY interface
-  withFdSocket sock $ \fd ->
-    (/= 0) <$> c_setsockopt fd c_IPPROTO_IP flag (castPtr mReqPtr) (#{size struct ip_mreq})
+  withFdSocket sock $ \fd -> do
+    rc <- c_setsockopt fd c_IPPROTO_IP flag (castPtr mReqPtr) (#{size struct ip_mreq})
+    if rc == 0
+      then pure $ Right ()
+      else pure $ Left rc
   where
     flag = if membership then c_IP_ADD_MEMBERSHIP else c_IP_DROP_MEMBERSHIP
 
diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs
index 2deb17777..45bea6066 100644
--- a/src/Simplex/Chat/Remote/Protocol.hs
+++ b/src/Simplex/Chat/Remote/Protocol.hs
@@ -66,8 +66,8 @@ $(deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse)
 
 -- * Client side / desktop
 
-createRemoteHostClient :: HTTP2Client -> Text -> ExceptT RemoteProtocolError IO RemoteHostClient
-createRemoteHostClient httpClient desktopName = do
+createRemoteHostClient :: HTTP2Client -> dh -> Text -> ExceptT RemoteProtocolError IO RemoteHostClient
+createRemoteHostClient httpClient todo'dhKey desktopName = do
   logDebug "Sending initial hello"
   sendRemoteCommand' httpClient localEncoding Nothing RCHello {deviceName = desktopName} >>= \case
     RRHello {encoding, deviceName = mobileName, encryptFiles} -> do
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index 6611d0447..4507c3de7 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -1,18 +1,39 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE GADTs #-}
 
 module Simplex.Chat.Remote.Types where
 
 import Control.Exception
+import Control.Monad
+import Crypto.Error (eitherCryptoError)
+import qualified Crypto.PubKey.Ed25519 as Ed25519
 import qualified Data.Aeson.TH as J
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteArray (convert)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Foldable (toList)
 import Data.Int (Int64)
 import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8Lenient, encodeUtf8)
+import Data.Time.Clock.System (SystemTime)
+import Data.Word (Word16)
+import Network.HTTP.Types (parseSimpleQuery)
+import Network.HTTP.Types.URI (renderSimpleQuery, urlDecode, urlEncode)
+import qualified Network.Socket as N
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile)
-import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
+import Simplex.Messaging.Encoding (Encoding (..))
+import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
+import Simplex.Messaging.Version (VersionRange, mkVersionRange)
 import UnliftIO
 
 data RemoteHostClient = RemoteHostClient
@@ -66,7 +87,6 @@ data RemoteHostInfo = RemoteHostInfo
   { remoteHostId :: RemoteHostId,
     storePath :: FilePath,
     displayName :: Text,
-    remoteCtrlOOB :: RemoteCtrlOOB,
     sessionActive :: Bool
   }
   deriving (Show)
@@ -98,6 +118,161 @@ data RemoteFile = RemoteFile
   }
   deriving (Show)
 
+ipProbeVersionRange :: VersionRange
+ipProbeVersionRange = mkVersionRange 1 1
+
+data IpProbe = IpProbe
+  { versionRange :: VersionRange,
+    randomNonce :: ByteString
+  } deriving (Show)
+
+instance Encoding IpProbe where
+  smpEncode IpProbe {versionRange, randomNonce} = smpEncode (versionRange, 'I', randomNonce)
+
+  smpP = IpProbe <$> (smpP <* "I") *> smpP
+
+announceVersionRange :: VersionRange
+announceVersionRange = mkVersionRange  1 1
+
+data Announce = Announce
+  { versionRange :: VersionRange,
+    sessionStart :: SystemTime,
+    announceCounter :: Word16,
+    serviceAddress :: (N.HostAddress, Word16),
+    caFingerprint :: C.KeyHash,
+    sessionDH :: C.PublicKeyX25519,
+    announceKey :: C.PublicKeyEd25519
+  } deriving (Show)
+
+instance Encoding Announce where
+  smpEncode Announce {versionRange, sessionStart, announceCounter, serviceAddress, caFingerprint, sessionDH, announceKey} =
+    smpEncode (versionRange, 'A', sessionStart, announceCounter, serviceAddress)
+      <> smpEncode (caFingerprint, sessionDH, announceKey)
+
+  smpP = Announce <$> (smpP <* "A") <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP
+
+data SignedAnnounce = SignedAnnounce Announce (C.Signature 'C.Ed25519)
+
+instance Encoding SignedAnnounce where
+  smpEncode (SignedAnnounce ann (C.SignatureEd25519 sig)) = smpEncode (ann, convert sig :: ByteString)
+
+  smpP = do
+    sa <- SignedAnnounce <$> smpP <*> signatureP
+    unless (verifySignedAnnounce sa) $ fail "bad announce signature"
+    pure sa
+    where
+      signatureP = do
+        bs <- smpP :: A.Parser ByteString
+        case eitherCryptoError (Ed25519.signature bs) of
+          Left ce -> fail $ show ce
+          Right ok -> pure $ C.SignatureEd25519 ok
+
+signAnnounce :: C.PrivateKey C.Ed25519 -> Announce -> SignedAnnounce
+signAnnounce announceSecret ann = SignedAnnounce ann sig
+  where
+    sig =
+      case C.sign (C.APrivateSignKey C.SEd25519 announceSecret) (smpEncode ann) of
+        C.ASignature C.SEd25519 s -> s
+        _ -> error "signing with ed25519"
+
+verifySignedAnnounce :: SignedAnnounce -> Bool
+verifySignedAnnounce (SignedAnnounce ann@Announce {announceKey} sig) = C.verify aKey aSig (smpEncode ann)
+  where
+    aKey = C.APublicVerifyKey C.SEd25519 announceKey
+    aSig = C.ASignature C.SEd25519 sig
+
+data OOB = OOB
+  { -- authority part
+    caFingerprint :: C.KeyHash,
+    authToken :: Text,
+    host :: Text,
+    port :: Word16,
+    -- query part
+    version :: VersionRange, -- v=
+    appName :: Text, -- app=
+    sigPubKey :: C.PublicKeyEd25519, -- key=
+    deviceName :: Maybe Text -- device=
+  }
+  deriving (Eq, Show)
+
+instance StrEncoding OOB where
+  strEncode OOB {caFingerprint, authToken, host, port, version, appName, sigPubKey, deviceName} =
+    schema <> "://" <> authority <> "#/?" <> renderSimpleQuery False query
+    where
+      schema = "xrcp"
+      authority =
+        mconcat
+          [ strEncode caFingerprint,
+            ":",
+            encodeUtf8 authToken,
+            "@",
+            encodeUtf8 host,
+            ":",
+            strEncode port
+          ]
+      query =
+        [ ("v", strEncode version),
+          ("app", encodeUtf8 appName),
+          ("key", strEncode $ C.encodePubKey sigPubKey)
+        ]
+          ++ [("device", urlEncode True $ encodeUtf8 name) | name <- toList deviceName]
+
+  strP = do
+    _ <- A.string "xrcp://"
+    caFingerprint <- strP
+    _ <- A.char ':'
+    authToken <- decodeUtf8Lenient <$> A.takeWhile (/= '@')
+    _ <- A.char '@'
+    host <- decodeUtf8Lenient <$> A.takeWhile (/= ':')
+    _ <- A.char ':'
+    port <- strP
+
+    _ <- A.string "#/?"
+    q <- parseSimpleQuery <$> A.takeByteString
+    version <- maybe (fail "missing version") (either fail pure . strDecode) (lookup "v" q)
+    appName <- maybe (fail "missing appName") (pure . decodeUtf8Lenient) (lookup "app" q)
+    sigPubKeyB64 <- maybe (fail "missing key") pure (lookup "key" q)
+    sigPubKey <- either fail pure $ strDecode sigPubKeyB64 >>= C.decodePubKey
+    let deviceName = fmap (decodeUtf8Lenient . urlDecode True) (lookup "device" q)
+    pure OOB {caFingerprint, authToken, host, port, version, appName, sigPubKey, deviceName}
+
+data SignedOOB = SignedOOB OOB (C.Signature 'C.Ed25519)
+  deriving (Eq, Show)
+
+instance StrEncoding SignedOOB where
+  strEncode (SignedOOB oob sig) = strEncode oob <> "&sig=" <> strEncode (C.signatureBytes sig)
+
+  strDecode s = do
+    unless (B.length sig == sigLen) $ Left "bad size"
+    unless ("&sig=" `B.isPrefixOf` sig) $ Left "bad signature prefix"
+    signedOOB <- SignedOOB <$> strDecode oob <*> (strDecode (B.drop 5 sig) >>= C.decodeSignature)
+    unless (verifySignedOOB signedOOB) $ Left "bad signature"
+    pure signedOOB
+    where
+      l = B.length s
+      (oob, sig) = B.splitAt (l - sigLen) s
+      sigLen = 93 -- &sig= + ed25519 sig size in base64 (88)
+
+  -- XXX: strP is used in chat command parser, but default strP assumes bas64url-encoded bytestring, where OOB is an URL-like
+  strP = A.takeWhile (/= ' ') >>= either fail pure . strDecode
+
+signOOB :: C.PrivateKey C.Ed25519 -> OOB -> SignedOOB
+signOOB key oob = SignedOOB oob sig
+  where
+    sig =
+      case C.sign (C.APrivateSignKey C.SEd25519 key) (strEncode oob) of
+        C.ASignature C.SEd25519 s -> s
+        _ -> error "signing with ed25519"
+
+verifySignedOOB :: SignedOOB -> Bool
+verifySignedOOB (SignedOOB oob@OOB {sigPubKey} sig) = C.verify aKey aSig (strEncode oob)
+  where
+    aKey = C.APublicVerifyKey C.SEd25519 sigPubKey
+    aSig = C.ASignature C.SEd25519 sig
+
+decodeOOBLink :: Text -> Either String OOB
+decodeOOBLink = fmap (\(SignedOOB oob _verified) -> oob) . strDecode . encodeUtf8
+
 data PlatformEncoding
   = PESwift
   | PEKotlin
@@ -125,8 +300,6 @@ $(J.deriveJSON (sumTypeJSON $ dropPrefix "RPE") ''RemoteProtocolError)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "PE") ''PlatformEncoding)
 
-$(J.deriveJSON defaultJSON ''RemoteCtrlOOB)
-
 $(J.deriveJSON defaultJSON ''RemoteHostInfo)
 
 $(J.deriveJSON defaultJSON ''RemoteCtrl)
diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs
index a4c2ef85e..0dfe665b2 100644
--- a/src/Simplex/Chat/Store/Remote.hs
+++ b/src/Simplex/Chat/Store/Remote.hs
@@ -6,13 +6,14 @@ module Simplex.Chat.Store.Remote where
 
 import Control.Monad.Except
 import Data.Int (Int64)
+import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Database.SQLite.Simple (Only (..))
 import qualified Database.SQLite.Simple as SQL
-import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
-import Simplex.Chat.Store.Shared
 import Simplex.Chat.Remote.Types
+import Simplex.Chat.Store.Shared
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
+import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 
 insertRemoteHost :: DB.Connection -> FilePath -> Text -> C.APrivateSignKey -> C.SignedCertificate -> IO RemoteHostId
@@ -39,8 +40,9 @@ toRemoteHost (remoteHostId, storePath, displayName, caKey, C.SignedObject caCert
 deleteRemoteHostRecord :: DB.Connection -> RemoteHostId -> IO ()
 deleteRemoteHostRecord db remoteHostId = DB.execute db "DELETE FROM remote_hosts WHERE remote_host_id = ?" (Only remoteHostId)
 
-insertRemoteCtrl :: DB.Connection -> RemoteCtrlOOB -> IO RemoteCtrlInfo
-insertRemoteCtrl db RemoteCtrlOOB {fingerprint, displayName} = do
+insertRemoteCtrl :: DB.Connection -> SignedOOB -> IO RemoteCtrlInfo
+insertRemoteCtrl db (SignedOOB OOB {deviceName, caFingerprint = fingerprint} _) = do
+  let displayName = fromMaybe "" deviceName
   DB.execute db "INSERT INTO remote_controllers (display_name, fingerprint) VALUES (?,?)" (displayName, fingerprint)
   remoteCtrlId <- insertedRowId db
   pure RemoteCtrlInfo {remoteCtrlId, displayName, fingerprint, accepted = Nothing, sessionActive = False}
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 9ae00159b..1810b6218 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -269,8 +269,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
   CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)]
   CRNtfMessages {} -> []
-  CRRemoteHostCreated RemoteHostInfo {remoteHostId, remoteCtrlOOB} -> ("remote host " <> sShow remoteHostId <> " created") : viewRemoteCtrlOOBData remoteCtrlOOB
+  CRRemoteHostCreated RemoteHostInfo {remoteHostId} -> ["remote host " <> sShow remoteHostId <> " created"]
   CRRemoteHostList hs -> viewRemoteHosts hs
+  CRRemoteHostStarted {remoteHost = RemoteHostInfo {remoteHostId = rhId}, sessionOOB} -> ["remote host " <> sShow rhId <> " started", "connection code:", plain sessionOOB]
   CRRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} -> ["remote host " <> sShow rhId <> " connected"]
   CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
   CRRemoteFileStored rhId (CryptoFile filePath cfArgs_) ->
@@ -447,7 +448,7 @@ viewGroupSubscribed :: GroupInfo -> [StyledString]
 viewGroupSubscribed g = [membershipIncognito g <> ttyFullGroup g <> ": connected to server(s)"]
 
 showSMPServer :: SMPServer -> String
-showSMPServer = B.unpack . strEncode . host
+showSMPServer srv = B.unpack $ strEncode srv.host
 
 viewHostEvent :: AProtocolType -> TransportHost -> String
 viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h)
@@ -1659,10 +1660,6 @@ viewVersionInfo logLevel CoreVersionInfo {version, simplexmqVersion, simplexmqCo
   where
     parens s = " (" <> s <> ")"
 
-viewRemoteCtrlOOBData :: RemoteCtrlOOB -> [StyledString]
-viewRemoteCtrlOOBData RemoteCtrlOOB {fingerprint} =
-  ["connection code:", plain $ strEncode fingerprint]
-
 viewRemoteHosts :: [RemoteHostInfo] -> [StyledString]
 viewRemoteHosts = \case
   [] -> ["No remote hosts"]
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index be1d3c1a2..ccbd543e9 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -8,12 +8,12 @@ module RemoteTests where
 import ChatClient
 import ChatTests.Utils
 import Control.Logger.Simple
-import Control.Monad
 import qualified Data.Aeson as J
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as M
+import Data.String (fromString)
 import Network.HTTP.Types (ok200)
 import qualified Network.HTTP2.Client as C
 import qualified Network.HTTP2.Server as S
@@ -23,11 +23,12 @@ import Simplex.Chat.Archive (archiveFilesFolder)
 import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..))
 import qualified Simplex.Chat.Controller as Controller
 import Simplex.Chat.Mobile.File
-import Simplex.Chat.Remote.Types
 import qualified Simplex.Chat.Remote.Discovery as Discovery
+import Simplex.Chat.Remote.Types
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
-import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Encoding (smpDecode)
+import Simplex.Messaging.Encoding.String (strDecode, strEncode)
 import qualified Simplex.Messaging.Transport as Transport
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
@@ -44,6 +45,7 @@ remoteTests :: SpecWith FilePath
 remoteTests = describe "Remote" $ do
   it "generates usable credentials" genCredentialsTest
   it "connects announcer with discoverer over reverse-http2" announceDiscoverHttp2Test
+  it "OOB encoding, decoding, and signatures are correct" oobCodecTest
   it "performs protocol handshake" remoteHandshakeTest
   it "performs protocol handshake (again)" remoteHandshakeTest -- leaking servers regression check
   it "sends messages" remoteMessageTest
@@ -59,8 +61,9 @@ genCredentialsTest _tmp = do
   started <- newEmptyTMVarIO
   bracket (Discovery.startTLSServer started credentials serverHandler) cancel $ \_server -> do
     ok <- atomically (readTMVar started)
-    unless ok $ error "TLS server failed to start"
-    Discovery.connectTLSClient "127.0.0.1" fingerprint clientHandler
+    port <- maybe (error "TLS server failed to start") pure ok
+    logNote $ "Assigned port: " <> tshow port
+    Discovery.connectTLSClient ("127.0.0.1", fromIntegral port) fingerprint clientHandler
   where
     serverHandler serverTls = do
       logNote "Sending from server"
@@ -75,15 +78,28 @@ genCredentialsTest _tmp = do
 
 -- * UDP discovery and rever HTTP2
 
+oobCodecTest :: (HasCallStack) => FilePath -> IO ()
+oobCodecTest _tmp = do
+  subscribers <- newTMVarIO 0
+  localAddr <- Discovery.getLocalAddress subscribers >>= maybe (fail "unable to get local address") pure
+  (fingerprint, _credentials) <- genTestCredentials
+  (_dhKey, _sigKey, _ann, signedOOB@(SignedOOB oob _sig)) <- Discovery.startSession (Just "Desktop") (localAddr, read Discovery.DISCOVERY_PORT) fingerprint
+  verifySignedOOB signedOOB `shouldBe` True
+  strDecode (strEncode oob) `shouldBe` Right oob
+  strDecode (strEncode signedOOB) `shouldBe` Right signedOOB
+
 announceDiscoverHttp2Test :: (HasCallStack) => FilePath -> IO ()
 announceDiscoverHttp2Test _tmp = do
+  subscribers <- newTMVarIO 0
+  localAddr <- Discovery.getLocalAddress subscribers >>= maybe (fail "unable to get local address") pure
   (fingerprint, credentials) <- genTestCredentials
+  (_dhKey, sigKey, ann, _oob) <- Discovery.startSession (Just "Desktop") (localAddr, read Discovery.DISCOVERY_PORT) fingerprint
   tasks <- newTVarIO []
   finished <- newEmptyMVar
   controller <- async $ do
     logNote "Controller: starting"
     bracket
-      (Discovery.announceRevHTTP2 tasks fingerprint credentials (putMVar finished ()) >>= either (fail . show) pure)
+      (Discovery.announceRevHTTP2 tasks (sigKey, ann) credentials (putMVar finished ()) >>= either (fail . show) pure)
       closeHTTP2Client
       ( \http -> do
           logNote "Controller: got client"
@@ -94,11 +110,14 @@ announceDiscoverHttp2Test _tmp = do
             Right HTTP2Response {} ->
               logNote "Controller: got response"
       )
-  host <- async $ Discovery.withListener $ \sock -> do
-    (N.SockAddrInet _port addr, invite) <- Discovery.recvAnnounce sock
-    strDecode invite `shouldBe` Right fingerprint
-    logNote "Host: connecting"
-    server <- async $ Discovery.connectTLSClient (THIPv4 $ N.hostAddressToTuple addr) fingerprint $ \tls -> do
+  host <- async $ Discovery.withListener subscribers $ \sock -> do
+    (N.SockAddrInet _port addr, sigAnn) <- Discovery.recvAnnounce sock
+    SignedAnnounce Announce {caFingerprint, serviceAddress=(hostAddr, port)} _sig <- either fail pure $ smpDecode sigAnn
+    caFingerprint `shouldBe` fingerprint
+    addr `shouldBe` hostAddr
+    let service = (THIPv4 $ N.hostAddressToTuple hostAddr, port)
+    logNote $ "Host: connecting to " <> tshow service
+    server <- async $ Discovery.connectTLSClient service fingerprint $ \tls -> do
       logNote "Host: got tls"
       flip Discovery.attachHTTP2Server tls $ \HTTP2Request {sendResponse} -> do
         logNote "Host: got request"
@@ -213,7 +232,7 @@ remoteStoreFileTest =
       -- send file not encrypted locally on mobile host
       desktop ##> "/_send @2 json {\"filePath\": \"test_1.pdf\", \"msgContent\": {\"type\": \"file\", \"text\": \"sending a file\"}}"
       desktop <# "@bob sending a file"
-      desktop <# "/f @bob test_1.pdf" 
+      desktop <# "/f @bob test_1.pdf"
       desktop <## "use /fc 1 to cancel sending"
       bob <# "alice> sending a file"
       bob <# "alice> sends file test_1.pdf (266.0 KiB / 272376 bytes)"
@@ -242,7 +261,7 @@ remoteStoreFileTest =
 
       -- send file encrypted locally on mobile host
       desktop ##> ("/_send @2 json {\"fileSource\": {\"filePath\":\"test_2.pdf\", \"cryptoArgs\": " <> LB.unpack (J.encode cfArgs) <> "}, \"msgContent\": {\"type\": \"file\", \"text\": \"\"}}")
-      desktop <# "/f @bob test_2.pdf" 
+      desktop <# "/f @bob test_2.pdf"
       desktop <## "use /fc 2 to cancel sending"
       bob <# "alice> sends file test_2.pdf (266.0 KiB / 272376 bytes)"
       bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
@@ -372,21 +391,30 @@ remoteCLIFileTest = testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile
 
 startRemote :: TestCC -> TestCC -> IO ()
 startRemote mobile desktop = do
+  desktop ##> "/set device name My desktop"
+  desktop <## "ok"
   desktop ##> "/create remote host"
   desktop <## "remote host 1 created"
-  desktop <## "connection code:"
-  fingerprint <- getTermLine desktop
-
+  -- A new host is started [automatically] by UI
   desktop ##> "/start remote host 1"
   desktop <## "ok"
+  desktop <## "remote host 1 started"
+  desktop <## "connection code:"
+  oobLink <- getTermLine desktop
+  OOB {caFingerprint = oobFingerprint} <- either (fail . mappend "OOB link failed: ") pure $ decodeOOBLink (fromString oobLink)
+  -- Desktop displays OOB QR code
 
+  mobile ##> "/set device name Mobile"
+  mobile <## "ok"
   mobile ##> "/start remote ctrl"
   mobile <## "ok"
   mobile <## "remote controller announced"
   mobile <## "connection code:"
-  fingerprint' <- getTermLine mobile
-  fingerprint' `shouldBe` fingerprint
-  mobile ##> ("/register remote ctrl " <> fingerprint' <> " " <> "My desktop")
+  annFingerprint <- getTermLine mobile
+  -- The user scans OOB QR code and confirms it matches the announced stuff
+  fromString annFingerprint `shouldBe` strEncode oobFingerprint
+
+  mobile ##> ("/register remote ctrl " <> oobLink)
   mobile <## "remote controller 1 registered"
   mobile ##> "/accept remote ctrl 1"
   mobile <## "ok" -- alternative scenario: accepted before controller start

From 02c0cd5619e1683e6cbfc40c1a7ac99f5c6e88de Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Wed, 1 Nov 2023 12:48:58 +0200
Subject: [PATCH 26/69] Cut at attaching http server/client (#3299)

* Cut at attaching http server/client

* switch to xrcp branch
---
 cabal.project                        |   2 +-
 package.yaml                         |   1 -
 simplex-chat.cabal                   |  11 +-
 src/Simplex/Chat/Controller.hs       |   1 +
 src/Simplex/Chat/Remote.hs           |   8 +-
 src/Simplex/Chat/Remote/Discovery.hs | 236 ---------------------------
 src/Simplex/Chat/Remote/RevHTTP.hs   |  54 ++++++
 src/Simplex/Chat/Remote/Types.hs     | 219 +++----------------------
 src/Simplex/Chat/Store/Remote.hs     |   1 +
 tests/RemoteTests.hs                 |  72 ++++----
 10 files changed, 121 insertions(+), 484 deletions(-)
 delete mode 100644 src/Simplex/Chat/Remote/Discovery.hs
 create mode 100644 src/Simplex/Chat/Remote/RevHTTP.hs

diff --git a/cabal.project b/cabal.project
index 9522fe233..b693f6c88 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: 0410948b56ea630dfa86441bbcf8ec97aeb1df01
+    tag: db1b2f77cd1c172fab26b68c507cdd2c1b7b0e63
 
 source-repository-package
     type: git
diff --git a/package.yaml b/package.yaml
index 095d2c134..2bfb36d18 100644
--- a/package.yaml
+++ b/package.yaml
@@ -36,7 +36,6 @@ dependencies:
   - mtl == 2.3.*
   - network >= 3.1.2.7 && < 3.2
   - network-transport == 0.5.6
-  - network-udp >= 0.0 && < 0.1
   - optparse-applicative >= 0.15 && < 0.17
   - process == 1.6.*
   - random >= 1.1 && < 1.3
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index db0324931..2dc77c3c2 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -130,9 +130,9 @@ library
       Simplex.Chat.ProfileGenerator
       Simplex.Chat.Protocol
       Simplex.Chat.Remote
-      Simplex.Chat.Remote.Discovery
       Simplex.Chat.Remote.Multicast
       Simplex.Chat.Remote.Protocol
+      Simplex.Chat.Remote.RevHTTP
       Simplex.Chat.Remote.Transport
       Simplex.Chat.Remote.Types
       Simplex.Chat.Store
@@ -184,7 +184,6 @@ library
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
     , network-transport ==0.5.6
-    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -237,7 +236,6 @@ executable simplex-bot
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
     , network-transport ==0.5.6
-    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -291,7 +289,6 @@ executable simplex-bot-advanced
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
     , network-transport ==0.5.6
-    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -347,7 +344,6 @@ executable simplex-broadcast-bot
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
     , network-transport ==0.5.6
-    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -402,7 +398,6 @@ executable simplex-chat
     , mtl ==2.3.*
     , network ==3.1.*
     , network-transport ==0.5.6
-    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -461,7 +456,6 @@ executable simplex-directory-service
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
     , network-transport ==0.5.6
-    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
@@ -546,7 +540,6 @@ test-suite simplex-chat-test
     , mtl ==2.3.*
     , network ==3.1.*
     , network-transport ==0.5.6
-    , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , random >=1.1 && <1.3
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index a54c6320e..25fe9294c 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -73,6 +73,7 @@ import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util (allFinally, catchAllErrors, liftEitherError, tryAllErrors, (<$$>))
 import Simplex.Messaging.Version
+import Simplex.RemoteControl.Types
 import System.IO (Handle)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index d6ccd2596..cc3eb9f19 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -40,8 +40,8 @@ import Simplex.Chat.Archive (archiveFilesFolder)
 import Simplex.Chat.Controller
 import Simplex.Chat.Files
 import Simplex.Chat.Messages (chatNameStr)
-import qualified Simplex.Chat.Remote.Discovery as Discovery
 import Simplex.Chat.Remote.Protocol
+import Simplex.Chat.Remote.RevHTTP (announceRevHTTP2, connectRevHTTP2)
 import Simplex.Chat.Remote.Transport
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store.Files
@@ -61,6 +61,8 @@ import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
 import Simplex.Messaging.Util (ifM, liftEitherError, liftEitherWith, liftError, liftIOEither, tryAllErrors, tshow, ($>>=), (<$$>))
+import qualified Simplex.RemoteControl.Discovery as Discovery
+import Simplex.RemoteControl.Types
 import System.FilePath (takeFileName, (</>))
 import UnliftIO
 import UnliftIO.Directory (copyFile, createDirectoryIfMissing, renameFile)
@@ -113,7 +115,7 @@ startRemoteHost rhId = do
       localAddr <- asks multicastSubscribers >>= Discovery.getLocalAddress >>= maybe (throwError . ChatError $ CEInternalError "unable to get local address") pure
       (dhKey, sigKey, ann, oob) <- Discovery.startSession (if rcName == "" then Nothing else Just rcName) (localAddr, read Discovery.DISCOVERY_PORT) fingerprint
       toView CRRemoteHostStarted {remoteHost = remoteHostInfo rh True, sessionOOB = decodeUtf8 $ strEncode oob}
-      httpClient <- liftEitherError (ChatErrorRemoteCtrl . RCEHTTP2Error . show) $ Discovery.announceRevHTTP2 tasks (sigKey, ann) credentials cleanupIO
+      httpClient <- liftEitherError (ChatErrorRemoteCtrl . RCEHTTP2Error . show) $ announceRevHTTP2 tasks (sigKey, ann) credentials cleanupIO
       logInfo $ "Remote host session connected for " <> tshow rhId
       -- test connection and establish a protocol layer
       remoteHostClient <- liftRH rhId $ createRemoteHostClient httpClient dhKey rcName
@@ -269,7 +271,7 @@ runHost discovered accepted handleHttp = do
   serviceAddress <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure -- wait for location of the matching fingerprint
   toView $ CRRemoteCtrlConnecting $ remoteCtrlInfo rc False
   atomically $ writeTVar discovered mempty -- flush unused sources
-  server <- async $ Discovery.connectRevHTTP2 serviceAddress fingerprint handleHttp -- spawn server for remote protocol commands
+  server <- async $ connectRevHTTP2 serviceAddress fingerprint handleHttp -- spawn server for remote protocol commands
   chatModifyVar remoteCtrlSession $ fmap $ \s -> s {hostServer = Just server}
   toView $ CRRemoteCtrlConnected $ remoteCtrlInfo rc True
   _ <- waitCatch server -- wait for the server to finish
diff --git a/src/Simplex/Chat/Remote/Discovery.hs b/src/Simplex/Chat/Remote/Discovery.hs
deleted file mode 100644
index 1ede108b0..000000000
--- a/src/Simplex/Chat/Remote/Discovery.hs
+++ /dev/null
@@ -1,236 +0,0 @@
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-
-module Simplex.Chat.Remote.Discovery where
-
-import Control.Logger.Simple
-import Control.Monad
-import Crypto.Random (getRandomBytes)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString.Base64.URL as B64U
-import Data.Default (def)
-import Data.String (IsString)
-import Data.Text (Text)
-import Data.Text.Encoding (decodeUtf8)
-import Data.Time.Clock.System (getSystemTime)
-import Data.Word (Word16)
-import qualified Network.Socket as N
-import qualified Network.TLS as TLS
-import qualified Network.UDP as UDP
-import Simplex.Chat.Remote.Multicast (setMembership)
-import Simplex.Chat.Remote.Types
-import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Encoding (Encoding (..))
-import Simplex.Messaging.Encoding.String (StrEncoding (..))
-import Simplex.Messaging.Transport (supportedParameters)
-import qualified Simplex.Messaging.Transport as Transport
-import Simplex.Messaging.Transport.Client (TransportHost (..), defaultTransportClientConfig, runTransportClient)
-import Simplex.Messaging.Transport.HTTP2 (defaultHTTP2BufferSize, getHTTP2Body)
-import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError (..), attachHTTP2Client, bodyHeadSize, connTimeout, defaultHTTP2ClientConfig)
-import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..), runHTTP2ServerWith)
-import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTransportServerSocket, startTCPServer)
-import Simplex.Messaging.Util (ifM, tshow)
-import Simplex.Messaging.Version (mkVersionRange)
-import UnliftIO
-import UnliftIO.Concurrent
-
--- | mDNS multicast group
-pattern MULTICAST_ADDR_V4 :: (IsString a, Eq a) => a
-pattern MULTICAST_ADDR_V4 = "224.0.0.251"
-
-pattern ANY_ADDR_V4 :: (IsString a, Eq a) => a
-pattern ANY_ADDR_V4 = "0.0.0.0"
-
-pattern DISCOVERY_PORT :: (IsString a, Eq a) => a
-pattern DISCOVERY_PORT = "5227"
-
-startSession :: MonadIO m => Maybe Text -> (N.HostAddress, Word16) -> C.KeyHash -> m ((C.APublicDhKey, C.APrivateDhKey), C.PrivateKeyEd25519, Announce, SignedOOB)
-startSession deviceName serviceAddress caFingerprint = liftIO $ do
-  sessionStart <- getSystemTime
-  dh@(C.APublicDhKey C.SX25519 sessionDH, _) <- C.generateDhKeyPair C.SX25519
-  (C.APublicVerifyKey C.SEd25519 sigPubKey, C.APrivateSignKey C.SEd25519 sigSecretKey) <- C.generateSignatureKeyPair C.SEd25519
-  let
-    announce =
-      Announce
-        { versionRange = announceVersionRange,
-          sessionStart,
-          announceCounter = 0,
-          serviceAddress,
-          caFingerprint,
-          sessionDH,
-          announceKey = sigPubKey
-        }
-  authToken <- decodeUtf8 . B64U.encode <$> getRandomBytes 12
-  let
-    oob =
-      OOB
-        { caFingerprint,
-          authToken,
-          host = decodeUtf8 . strEncode $ THIPv4 . N.hostAddressToTuple $ fst serviceAddress,
-          port = snd serviceAddress,
-          version = mkVersionRange 1 1,
-          appName = "simplex-chat",
-          sigPubKey,
-          deviceName
-        }
-  pure (dh, sigSecretKey, announce, signOOB sigSecretKey oob)
-
-getLocalAddress :: MonadIO m => TMVar Int -> m (Maybe N.HostAddress)
-getLocalAddress subscribers = liftIO $ do
-  probe <- mkIpProbe
-  let bytes = smpEncode probe
-  withListener subscribers $ \receiver ->
-    withSender $ \sender -> do
-      UDP.send sender bytes
-      let expect = do
-            UDP.recvFrom receiver >>= \case
-              (p, _) | p /= bytes -> expect
-              (_, UDP.ClientSockAddr (N.SockAddrInet _port host) _cmsg) -> pure host
-              (_, UDP.ClientSockAddr _badAddr _) -> error "receiving from IPv4 socket"
-      timeout 1000000 expect
-
-mkIpProbe :: MonadIO m => m IpProbe
-mkIpProbe = do
-  randomNonce <- liftIO $ getRandomBytes 32
-  pure IpProbe {versionRange = ipProbeVersionRange, randomNonce}
-
--- | Announce tls server, wait for connection and attach http2 client to it.
---
--- Announcer is started when TLS server is started and stopped when a connection is made.
-announceRevHTTP2 :: Tasks -> (C.PrivateKeyEd25519, Announce) -> TLS.Credentials -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
-announceRevHTTP2 tasks (sigKey, announce@Announce {caFingerprint, serviceAddress=(host, _port)}) credentials finishAction = do
-  httpClient <- newEmptyMVar
-  started <- newEmptyTMVarIO
-  finished <- newEmptyMVar
-  _ <- forkIO $ readMVar finished >> finishAction -- attach external cleanup action to session lock
-  announcer <- async . liftIO $ atomically (takeTMVar started) >>= \case
-    Nothing -> pure () -- TLS server failed to start, skipping announcer
-    Just givenPort -> do
-      logInfo $ "Starting announcer for " <> ident <> " at " <> tshow (host, givenPort)
-      runAnnouncer (sigKey, announce {serviceAddress = (host, fromIntegral givenPort)})
-  tasks `registerAsync` announcer
-  tlsServer <- startTLSServer started credentials $ \tls -> do
-    logInfo $ "Incoming connection for " <> ident
-    cancel announcer
-    runHTTP2Client finished httpClient tls `catchAny` (logError . tshow)
-    logInfo $ "Client finished for " <> ident
-  -- BUG: this should be handled in HTTP2Client wrapper, partially handled in startTLSServer
-  _ <- forkIO $ waitCatch tlsServer >> void (tryPutMVar finished ())
-  tasks `registerAsync` tlsServer
-  logInfo $ "Waiting for client for " <> ident
-  readMVar httpClient
-  where
-    ident = decodeUtf8 $ strEncode caFingerprint
-
--- | Send replay-proof announce datagrams
-runAnnouncer :: (C.PrivateKeyEd25519, Announce) -> IO ()
-runAnnouncer (announceKey, initialAnnounce) = withSender $ loop initialAnnounce
-  where
-    loop announce sock = do
-      UDP.send sock $ smpEncode (signAnnounce announceKey announce)
-      threadDelay 1000000
-      loop announce {announceCounter = announceCounter announce + 1} sock
-
-startTLSServer :: (MonadUnliftIO m) => TMVar (Maybe N.PortNumber) -> TLS.Credentials -> (Transport.TLS -> IO ()) -> m (Async ())
-startTLSServer started credentials server = async . liftIO $ do
-  startedOk <- newEmptyTMVarIO
-  bracketOnError (startTCPServer startedOk "0") (\_e -> void . atomically $ tryPutTMVar started Nothing) $ \socket ->
-    ifM
-      (atomically $ readTMVar startedOk)
-      do
-        port <- N.socketPort socket
-        logInfo $ "System-assigned port: " <> tshow port
-        atomically $ putTMVar started (Just port)
-        runTransportServerSocket startedOk (pure socket) "RCP TLS" serverParams defaultTransportServerConfig server
-      (void . atomically $ tryPutTMVar started Nothing)
-  where
-    serverParams =
-      def
-        { TLS.serverWantClientCert = False,
-          TLS.serverShared = def {TLS.sharedCredentials = credentials},
-          TLS.serverHooks = def,
-          TLS.serverSupported = supportedParameters
-        }
-
--- | Attach HTTP2 client and hold the TLS until the attached client finishes.
-runHTTP2Client :: MVar () -> MVar (Either HTTP2ClientError HTTP2Client) -> Transport.TLS -> IO ()
-runHTTP2Client finishedVar clientVar tls =
-  ifM (isEmptyMVar clientVar)
-    attachClient
-    (logError "HTTP2 session already started on this listener")
-  where
-    attachClient = do
-      client <- attachHTTP2Client config ANY_ADDR_V4 DISCOVERY_PORT (putMVar finishedVar ()) defaultHTTP2BufferSize tls
-      putMVar clientVar client
-      readMVar finishedVar
-    -- TODO connection timeout
-    config = defaultHTTP2ClientConfig {bodyHeadSize = doNotPrefetchHead, connTimeout = maxBound}
-
-withSender :: MonadUnliftIO m => (UDP.UDPSocket -> m a) -> m a
-withSender = bracket (liftIO $ UDP.clientSocket MULTICAST_ADDR_V4 DISCOVERY_PORT False) (liftIO . UDP.close)
-
-withListener :: MonadUnliftIO m => TMVar Int -> (UDP.ListenSocket -> m a) -> m a
-withListener subscribers = bracket (openListener subscribers) (closeListener subscribers)
-
-openListener :: MonadIO m => TMVar Int -> m UDP.ListenSocket
-openListener subscribers = liftIO $ do
-  sock <- UDP.serverSocket (MULTICAST_ADDR_V4, read DISCOVERY_PORT)
-  logDebug $ "Discovery listener socket: " <> tshow sock
-  let raw = UDP.listenSocket sock
-  -- N.setSocketOption raw N.Broadcast 1
-  joinMulticast subscribers raw (listenerHostAddr4 sock)
-  pure sock
-
-closeListener :: MonadIO m => TMVar Int -> UDP.ListenSocket -> m ()
-closeListener subscribers sock = liftIO $
-  partMulticast subscribers (UDP.listenSocket sock) (listenerHostAddr4 sock) `finally` UDP.stop sock
-
-joinMulticast :: TMVar Int -> N.Socket -> N.HostAddress -> IO ()
-joinMulticast subscribers sock group = do
-  now <- atomically $ takeTMVar subscribers
-  when (now == 0) $ do
-    setMembership sock group True >>= \case
-      Left e -> atomically (putTMVar subscribers now) >> logError ("setMembership failed " <> tshow e)
-      Right () -> atomically $ putTMVar subscribers (now + 1)
-
-partMulticast :: TMVar Int -> N.Socket -> N.HostAddress -> IO ()
-partMulticast subscribers sock group = do
-  now <- atomically $ takeTMVar subscribers
-  when (now == 1) $
-    setMembership sock group False >>= \case
-      Left e -> atomically (putTMVar subscribers now) >> logError ("setMembership failed " <> tshow e)
-      Right () -> atomically $ putTMVar subscribers (now - 1)
-
-listenerHostAddr4 :: UDP.ListenSocket -> N.HostAddress
-listenerHostAddr4 sock = case UDP.mySockAddr sock of
-  N.SockAddrInet _port host -> host
-  _ -> error "MULTICAST_ADDR_V4 is V4"
-
-recvAnnounce :: (MonadIO m) => UDP.ListenSocket -> m (N.SockAddr, ByteString)
-recvAnnounce sock = liftIO $ do
-  (invite, UDP.ClientSockAddr source _cmsg) <- UDP.recvFrom sock
-  pure (source, invite)
-
-connectRevHTTP2 :: (MonadUnliftIO m) => (TransportHost, Word16) -> C.KeyHash -> (HTTP2Request -> m ()) -> m ()
-connectRevHTTP2 serviceAddress fingerprint = connectTLSClient serviceAddress fingerprint . attachHTTP2Server
-
-connectTLSClient :: (MonadUnliftIO m) => (TransportHost, Word16) -> C.KeyHash -> (Transport.TLS -> m a) -> m a
-connectTLSClient (host, port) caFingerprint = runTransportClient defaultTransportClientConfig Nothing host (show port) (Just caFingerprint)
-
-attachHTTP2Server :: (MonadUnliftIO m) => (HTTP2Request -> m ()) -> Transport.TLS -> m ()
-attachHTTP2Server processRequest tls = do
-  withRunInIO $ \unlift ->
-    runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
-      reqBody <- getHTTP2Body r doNotPrefetchHead
-      unlift $ processRequest HTTP2Request {sessionId, request = r, reqBody, sendResponse}
-
--- | Suppress storing initial chunk in bodyHead, forcing clients and servers to stream chunks
-doNotPrefetchHead :: Int
-doNotPrefetchHead = 0
diff --git a/src/Simplex/Chat/Remote/RevHTTP.hs b/src/Simplex/Chat/Remote/RevHTTP.hs
new file mode 100644
index 000000000..c6c777596
--- /dev/null
+++ b/src/Simplex/Chat/Remote/RevHTTP.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Chat.Remote.RevHTTP where
+
+import Simplex.RemoteControl.Discovery
+import Simplex.RemoteControl.Types
+import Control.Logger.Simple
+import Data.Word (Word16)
+import qualified Network.TLS as TLS
+import qualified Simplex.Messaging.Crypto as C
+import qualified Simplex.Messaging.Transport as Transport
+import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Transport.HTTP2 (defaultHTTP2BufferSize, getHTTP2Body)
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError (..), attachHTTP2Client, bodyHeadSize, connTimeout, defaultHTTP2ClientConfig)
+import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..), runHTTP2ServerWith)
+import Simplex.Messaging.Util (ifM)
+import UnliftIO
+
+announceRevHTTP2 :: MonadUnliftIO m => Tasks -> (C.PrivateKeyEd25519, Announce) -> TLS.Credentials -> m () -> m (Either HTTP2ClientError HTTP2Client)
+announceRevHTTP2 = announceCtrl runHTTP2Client
+
+-- | Attach HTTP2 client and hold the TLS until the attached client finishes.
+runHTTP2Client :: MVar () -> MVar (Either HTTP2ClientError HTTP2Client) -> Transport.TLS -> IO ()
+runHTTP2Client finishedVar clientVar tls =
+  ifM (isEmptyMVar clientVar)
+    attachClient
+    (logError "HTTP2 session already started on this listener")
+  where
+    attachClient = do
+      client <- attachHTTP2Client config ANY_ADDR_V4 DISCOVERY_PORT (putMVar finishedVar ()) defaultHTTP2BufferSize tls
+      putMVar clientVar client
+      readMVar finishedVar
+    -- TODO connection timeout
+    config = defaultHTTP2ClientConfig {bodyHeadSize = doNotPrefetchHead, connTimeout = maxBound}
+
+connectRevHTTP2 :: (MonadUnliftIO m) => (TransportHost, Word16) -> C.KeyHash -> (HTTP2Request -> m ()) -> m ()
+connectRevHTTP2 serviceAddress fingerprint = connectTLSClient serviceAddress fingerprint . attachHTTP2Server
+
+attachHTTP2Server :: (MonadUnliftIO m) => (HTTP2Request -> m ()) -> Transport.TLS -> m ()
+attachHTTP2Server processRequest tls = do
+  withRunInIO $ \unlift ->
+    runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
+      reqBody <- getHTTP2Body r doNotPrefetchHead
+      unlift $ processRequest HTTP2Request {sessionId, request = r, reqBody, sendResponse}
+
+-- | Suppress storing initial chunk in bodyHead, forcing clients and servers to stream chunks
+doNotPrefetchHead :: Int
+doNotPrefetchHead = 0
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index 4507c3de7..dcf70ab71 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -2,39 +2,22 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE GADTs #-}
 
 module Simplex.Chat.Remote.Types where
 
-import Control.Exception
-import Control.Monad
-import Crypto.Error (eitherCryptoError)
-import qualified Crypto.PubKey.Ed25519 as Ed25519
+import Control.Exception (Exception)
 import qualified Data.Aeson.TH as J
-import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteArray (convert)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as B
-import Data.Foldable (toList)
 import Data.Int (Int64)
 import Data.Text (Text)
-import Data.Text.Encoding (decodeUtf8Lenient, encodeUtf8)
-import Data.Time.Clock.System (SystemTime)
-import Data.Word (Word16)
-import Network.HTTP.Types (parseSimpleQuery)
-import Network.HTTP.Types.URI (renderSimpleQuery, urlDecode, urlEncode)
-import qualified Network.Socket as N
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.File (CryptoFile)
-import Simplex.Messaging.Encoding (Encoding (..))
-import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
-import Simplex.Messaging.Version (VersionRange, mkVersionRange)
-import UnliftIO
+import Simplex.RemoteControl.Types (Tasks)
+import Simplex.Messaging.Crypto.File (CryptoFile)
 
 data RemoteHostClient = RemoteHostClient
   { hostEncoding :: PlatformEncoding,
@@ -50,15 +33,19 @@ data RemoteHostSession = RemoteHostSession
   }
 
 data RemoteProtocolError
-  = RPEInvalidSize -- ^ size prefix is malformed
-  | RPEInvalidJSON {invalidJSON :: Text} -- ^ failed to parse RemoteCommand or RemoteResponse
+  = -- | size prefix is malformed
+    RPEInvalidSize
+  | -- | failed to parse RemoteCommand or RemoteResponse
+    RPEInvalidJSON {invalidJSON :: Text}
   | RPEIncompatibleEncoding
   | RPEUnexpectedFile
   | RPENoFile
   | RPEFileSize
   | RPEFileDigest
-  | RPEUnexpectedResponse {response :: Text} -- ^ Wrong response received for the command sent
-  | RPEStoredFileExists -- ^ A file already exists in the destination position
+  | -- | Wrong response received for the command sent
+    RPEUnexpectedResponse {response :: Text}
+  | -- | A file already exists in the destination position
+    RPEStoredFileExists
   | RPEHTTP2 {http2Error :: Text}
   | RPEException {someException :: Text}
   deriving (Show, Exception)
@@ -110,169 +97,6 @@ data RemoteCtrlInfo = RemoteCtrlInfo
   }
   deriving (Show)
 
-data RemoteFile = RemoteFile
-  { userId :: Int64,
-    fileId :: Int64,
-    sent :: Bool,
-    fileSource :: CryptoFile
-  }
-  deriving (Show)
-
-ipProbeVersionRange :: VersionRange
-ipProbeVersionRange = mkVersionRange 1 1
-
-data IpProbe = IpProbe
-  { versionRange :: VersionRange,
-    randomNonce :: ByteString
-  } deriving (Show)
-
-instance Encoding IpProbe where
-  smpEncode IpProbe {versionRange, randomNonce} = smpEncode (versionRange, 'I', randomNonce)
-
-  smpP = IpProbe <$> (smpP <* "I") *> smpP
-
-announceVersionRange :: VersionRange
-announceVersionRange = mkVersionRange  1 1
-
-data Announce = Announce
-  { versionRange :: VersionRange,
-    sessionStart :: SystemTime,
-    announceCounter :: Word16,
-    serviceAddress :: (N.HostAddress, Word16),
-    caFingerprint :: C.KeyHash,
-    sessionDH :: C.PublicKeyX25519,
-    announceKey :: C.PublicKeyEd25519
-  } deriving (Show)
-
-instance Encoding Announce where
-  smpEncode Announce {versionRange, sessionStart, announceCounter, serviceAddress, caFingerprint, sessionDH, announceKey} =
-    smpEncode (versionRange, 'A', sessionStart, announceCounter, serviceAddress)
-      <> smpEncode (caFingerprint, sessionDH, announceKey)
-
-  smpP = Announce <$> (smpP <* "A") <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP
-
-data SignedAnnounce = SignedAnnounce Announce (C.Signature 'C.Ed25519)
-
-instance Encoding SignedAnnounce where
-  smpEncode (SignedAnnounce ann (C.SignatureEd25519 sig)) = smpEncode (ann, convert sig :: ByteString)
-
-  smpP = do
-    sa <- SignedAnnounce <$> smpP <*> signatureP
-    unless (verifySignedAnnounce sa) $ fail "bad announce signature"
-    pure sa
-    where
-      signatureP = do
-        bs <- smpP :: A.Parser ByteString
-        case eitherCryptoError (Ed25519.signature bs) of
-          Left ce -> fail $ show ce
-          Right ok -> pure $ C.SignatureEd25519 ok
-
-signAnnounce :: C.PrivateKey C.Ed25519 -> Announce -> SignedAnnounce
-signAnnounce announceSecret ann = SignedAnnounce ann sig
-  where
-    sig =
-      case C.sign (C.APrivateSignKey C.SEd25519 announceSecret) (smpEncode ann) of
-        C.ASignature C.SEd25519 s -> s
-        _ -> error "signing with ed25519"
-
-verifySignedAnnounce :: SignedAnnounce -> Bool
-verifySignedAnnounce (SignedAnnounce ann@Announce {announceKey} sig) = C.verify aKey aSig (smpEncode ann)
-  where
-    aKey = C.APublicVerifyKey C.SEd25519 announceKey
-    aSig = C.ASignature C.SEd25519 sig
-
-data OOB = OOB
-  { -- authority part
-    caFingerprint :: C.KeyHash,
-    authToken :: Text,
-    host :: Text,
-    port :: Word16,
-    -- query part
-    version :: VersionRange, -- v=
-    appName :: Text, -- app=
-    sigPubKey :: C.PublicKeyEd25519, -- key=
-    deviceName :: Maybe Text -- device=
-  }
-  deriving (Eq, Show)
-
-instance StrEncoding OOB where
-  strEncode OOB {caFingerprint, authToken, host, port, version, appName, sigPubKey, deviceName} =
-    schema <> "://" <> authority <> "#/?" <> renderSimpleQuery False query
-    where
-      schema = "xrcp"
-      authority =
-        mconcat
-          [ strEncode caFingerprint,
-            ":",
-            encodeUtf8 authToken,
-            "@",
-            encodeUtf8 host,
-            ":",
-            strEncode port
-          ]
-      query =
-        [ ("v", strEncode version),
-          ("app", encodeUtf8 appName),
-          ("key", strEncode $ C.encodePubKey sigPubKey)
-        ]
-          ++ [("device", urlEncode True $ encodeUtf8 name) | name <- toList deviceName]
-
-  strP = do
-    _ <- A.string "xrcp://"
-    caFingerprint <- strP
-    _ <- A.char ':'
-    authToken <- decodeUtf8Lenient <$> A.takeWhile (/= '@')
-    _ <- A.char '@'
-    host <- decodeUtf8Lenient <$> A.takeWhile (/= ':')
-    _ <- A.char ':'
-    port <- strP
-
-    _ <- A.string "#/?"
-    q <- parseSimpleQuery <$> A.takeByteString
-    version <- maybe (fail "missing version") (either fail pure . strDecode) (lookup "v" q)
-    appName <- maybe (fail "missing appName") (pure . decodeUtf8Lenient) (lookup "app" q)
-    sigPubKeyB64 <- maybe (fail "missing key") pure (lookup "key" q)
-    sigPubKey <- either fail pure $ strDecode sigPubKeyB64 >>= C.decodePubKey
-    let deviceName = fmap (decodeUtf8Lenient . urlDecode True) (lookup "device" q)
-    pure OOB {caFingerprint, authToken, host, port, version, appName, sigPubKey, deviceName}
-
-data SignedOOB = SignedOOB OOB (C.Signature 'C.Ed25519)
-  deriving (Eq, Show)
-
-instance StrEncoding SignedOOB where
-  strEncode (SignedOOB oob sig) = strEncode oob <> "&sig=" <> strEncode (C.signatureBytes sig)
-
-  strDecode s = do
-    unless (B.length sig == sigLen) $ Left "bad size"
-    unless ("&sig=" `B.isPrefixOf` sig) $ Left "bad signature prefix"
-    signedOOB <- SignedOOB <$> strDecode oob <*> (strDecode (B.drop 5 sig) >>= C.decodeSignature)
-    unless (verifySignedOOB signedOOB) $ Left "bad signature"
-    pure signedOOB
-    where
-      l = B.length s
-      (oob, sig) = B.splitAt (l - sigLen) s
-      sigLen = 93 -- &sig= + ed25519 sig size in base64 (88)
-
-  -- XXX: strP is used in chat command parser, but default strP assumes bas64url-encoded bytestring, where OOB is an URL-like
-  strP = A.takeWhile (/= ' ') >>= either fail pure . strDecode
-
-signOOB :: C.PrivateKey C.Ed25519 -> OOB -> SignedOOB
-signOOB key oob = SignedOOB oob sig
-  where
-    sig =
-      case C.sign (C.APrivateSignKey C.SEd25519 key) (strEncode oob) of
-        C.ASignature C.SEd25519 s -> s
-        _ -> error "signing with ed25519"
-
-verifySignedOOB :: SignedOOB -> Bool
-verifySignedOOB (SignedOOB oob@OOB {sigPubKey} sig) = C.verify aKey aSig (strEncode oob)
-  where
-    aKey = C.APublicVerifyKey C.SEd25519 sigPubKey
-    aSig = C.ASignature C.SEd25519 sig
-
-decodeOOBLink :: Text -> Either String OOB
-decodeOOBLink = fmap (\(SignedOOB oob _verified) -> oob) . strDecode . encodeUtf8
-
 data PlatformEncoding
   = PESwift
   | PEKotlin
@@ -285,16 +109,15 @@ localEncoding = PESwift
 localEncoding = PEKotlin
 #endif
 
-type Tasks = TVar [Async ()]
+data RemoteFile = RemoteFile
+  { userId :: Int64,
+    fileId :: Int64,
+    sent :: Bool,
+    fileSource :: CryptoFile
+  }
+  deriving (Show)
 
-asyncRegistered :: MonadUnliftIO m => Tasks -> m () -> m ()
-asyncRegistered tasks action = async action >>= registerAsync tasks
-
-registerAsync :: MonadIO m => Tasks -> Async () -> m ()
-registerAsync tasks = atomically . modifyTVar tasks . (:)
-
-cancelTasks :: (MonadIO m) => Tasks -> m ()
-cancelTasks tasks = readTVarIO tasks >>= mapM_ cancel
+$(J.deriveJSON defaultJSON ''RemoteFile)
 
 $(J.deriveJSON (sumTypeJSON $ dropPrefix "RPE") ''RemoteProtocolError)
 
@@ -305,5 +128,3 @@ $(J.deriveJSON defaultJSON ''RemoteHostInfo)
 $(J.deriveJSON defaultJSON ''RemoteCtrl)
 
 $(J.deriveJSON defaultJSON ''RemoteCtrlInfo)
-
-$(J.deriveJSON defaultJSON ''RemoteFile)
diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs
index 0dfe665b2..df7ccd499 100644
--- a/src/Simplex/Chat/Store/Remote.hs
+++ b/src/Simplex/Chat/Store/Remote.hs
@@ -15,6 +15,7 @@ import Simplex.Chat.Store.Shared
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.RemoteControl.Types
 
 insertRemoteHost :: DB.Connection -> FilePath -> Text -> C.APrivateSignKey -> C.SignedCertificate -> IO RemoteHostId
 insertRemoteHost db storePath displayName caKey caCert = do
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index ccbd543e9..7c62333d6 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -5,6 +5,9 @@
 
 module RemoteTests where
 
+import Simplex.Chat.Remote.RevHTTP
+import qualified Simplex.RemoteControl.Discovery as Discovery
+import Simplex.RemoteControl.Types
 import ChatClient
 import ChatTests.Utils
 import Control.Logger.Simple
@@ -23,13 +26,11 @@ import Simplex.Chat.Archive (archiveFilesFolder)
 import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..))
 import qualified Simplex.Chat.Controller as Controller
 import Simplex.Chat.Mobile.File
-import qualified Simplex.Chat.Remote.Discovery as Discovery
 import Simplex.Chat.Remote.Types
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
 import Simplex.Messaging.Encoding (smpDecode)
 import Simplex.Messaging.Encoding.String (strDecode, strEncode)
-import qualified Simplex.Messaging.Transport as Transport
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Response (..), closeHTTP2Client, sendRequest)
@@ -43,9 +44,9 @@ import UnliftIO.Directory
 
 remoteTests :: SpecWith FilePath
 remoteTests = describe "Remote" $ do
-  it "generates usable credentials" genCredentialsTest
+  -- it "generates usable credentials" genCredentialsTest
+  -- it "OOB encoding, decoding, and signatures are correct" oobCodecTest
   it "connects announcer with discoverer over reverse-http2" announceDiscoverHttp2Test
-  it "OOB encoding, decoding, and signatures are correct" oobCodecTest
   it "performs protocol handshake" remoteHandshakeTest
   it "performs protocol handshake (again)" remoteHandshakeTest -- leaking servers regression check
   it "sends messages" remoteMessageTest
@@ -55,38 +56,39 @@ remoteTests = describe "Remote" $ do
 
 -- * Low-level TLS with ephemeral credentials
 
-genCredentialsTest :: (HasCallStack) => FilePath -> IO ()
-genCredentialsTest _tmp = do
-  (fingerprint, credentials) <- genTestCredentials
-  started <- newEmptyTMVarIO
-  bracket (Discovery.startTLSServer started credentials serverHandler) cancel $ \_server -> do
-    ok <- atomically (readTMVar started)
-    port <- maybe (error "TLS server failed to start") pure ok
-    logNote $ "Assigned port: " <> tshow port
-    Discovery.connectTLSClient ("127.0.0.1", fromIntegral port) fingerprint clientHandler
-  where
-    serverHandler serverTls = do
-      logNote "Sending from server"
-      Transport.putLn serverTls "hi client"
-      logNote "Reading from server"
-      Transport.getLn serverTls `shouldReturn` "hi server"
-    clientHandler clientTls = do
-      logNote "Sending from client"
-      Transport.putLn clientTls "hi server"
-      logNote "Reading from client"
-      Transport.getLn clientTls `shouldReturn` "hi client"
+-- -- XXX: extract
+-- genCredentialsTest :: (HasCallStack) => FilePath -> IO ()
+-- genCredentialsTest _tmp = do
+--   (fingerprint, credentials) <- genTestCredentials
+--   started <- newEmptyTMVarIO
+--   bracket (startTLSServer started credentials serverHandler) cancel $ \_server -> do
+--     ok <- atomically (readTMVar started)
+--     port <- maybe (error "TLS server failed to start") pure ok
+--     logNote $ "Assigned port: " <> tshow port
+--     connectTLSClient ("127.0.0.1", fromIntegral port) fingerprint clientHandler
+--   where
+--     serverHandler serverTls = do
+--       logNote "Sending from server"
+--       Transport.putLn serverTls "hi client"
+--       logNote "Reading from server"
+--       Transport.getLn serverTls `shouldReturn` "hi server"
+--     clientHandler clientTls = do
+--       logNote "Sending from client"
+--       Transport.putLn clientTls "hi server"
+--       logNote "Reading from client"
+--       Transport.getLn clientTls `shouldReturn` "hi client"
 
 -- * UDP discovery and rever HTTP2
 
-oobCodecTest :: (HasCallStack) => FilePath -> IO ()
-oobCodecTest _tmp = do
-  subscribers <- newTMVarIO 0
-  localAddr <- Discovery.getLocalAddress subscribers >>= maybe (fail "unable to get local address") pure
-  (fingerprint, _credentials) <- genTestCredentials
-  (_dhKey, _sigKey, _ann, signedOOB@(SignedOOB oob _sig)) <- Discovery.startSession (Just "Desktop") (localAddr, read Discovery.DISCOVERY_PORT) fingerprint
-  verifySignedOOB signedOOB `shouldBe` True
-  strDecode (strEncode oob) `shouldBe` Right oob
-  strDecode (strEncode signedOOB) `shouldBe` Right signedOOB
+-- oobCodecTest :: (HasCallStack) => FilePath -> IO ()
+-- oobCodecTest _tmp = do
+--   subscribers <- newTMVarIO 0
+--   localAddr <- Discovery.getLocalAddress subscribers >>= maybe (fail "unable to get local address") pure
+--   (fingerprint, _credentials) <- genTestCredentials
+--   (_dhKey, _sigKey, _ann, signedOOB@(SignedOOB oob _sig)) <- Discovery.startSession (Just "Desktop") (localAddr, read Discovery.DISCOVERY_PORT) fingerprint
+--   verifySignedOOB signedOOB `shouldBe` True
+--   strDecode (strEncode oob) `shouldBe` Right oob
+--   strDecode (strEncode signedOOB) `shouldBe` Right signedOOB
 
 announceDiscoverHttp2Test :: (HasCallStack) => FilePath -> IO ()
 announceDiscoverHttp2Test _tmp = do
@@ -99,7 +101,7 @@ announceDiscoverHttp2Test _tmp = do
   controller <- async $ do
     logNote "Controller: starting"
     bracket
-      (Discovery.announceRevHTTP2 tasks (sigKey, ann) credentials (putMVar finished ()) >>= either (fail . show) pure)
+      (announceRevHTTP2 tasks (sigKey, ann) credentials (putMVar finished ()) >>= either (fail . show) pure)
       closeHTTP2Client
       ( \http -> do
           logNote "Controller: got client"
@@ -119,7 +121,7 @@ announceDiscoverHttp2Test _tmp = do
     logNote $ "Host: connecting to " <> tshow service
     server <- async $ Discovery.connectTLSClient service fingerprint $ \tls -> do
       logNote "Host: got tls"
-      flip Discovery.attachHTTP2Server tls $ \HTTP2Request {sendResponse} -> do
+      flip attachHTTP2Server tls $ \HTTP2Request {sendResponse} -> do
         logNote "Host: got request"
         sendResponse $ S.responseNoBody ok200 []
         logNote "Host: sent response"

From 8482dbfd99810edc98cae6e0e13c3b613ff9206d Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Wed, 1 Nov 2023 19:08:36 +0000
Subject: [PATCH 27/69] core: update remote API commands/events (#3295)

* core: update remote API

* Add session verification event between tls and http2

* roll back char_ '@' parsers

* use more specific parser for verification codes

* cabal.project.local for mac

---------

Co-authored-by: IC Rainbow <aenor.realm@gmail.com>
---
 cabal.project                      |   2 +-
 scripts/cabal.project.local.mac    |   5 ++
 src/Simplex/Chat.hs                |  28 ++++----
 src/Simplex/Chat/Controller.hs     |  41 ++++++------
 src/Simplex/Chat/Remote.hs         | 100 +++++++++++++++++------------
 src/Simplex/Chat/Remote/RevHTTP.hs |   5 --
 src/Simplex/Chat/View.hs           |  19 ++++--
 tests/RemoteTests.hs               |  21 ++++--
 8 files changed, 130 insertions(+), 91 deletions(-)

diff --git a/cabal.project b/cabal.project
index b693f6c88..7fe664f4e 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: db1b2f77cd1c172fab26b68c507cdd2c1b7b0e63
+    tag: a5fed340e2814a226180ce1abe606ac79366fe5b
 
 source-repository-package
     type: git
diff --git a/scripts/cabal.project.local.mac b/scripts/cabal.project.local.mac
index 35c10db75..dd62f1a39 100644
--- a/scripts/cabal.project.local.mac
+++ b/scripts/cabal.project.local.mac
@@ -1,6 +1,11 @@
 ignore-project: False
 
 -- amend to point to the actual openssl location
+
+package simplexmq
+    extra-include-dirs: /opt/homebrew/opt/openssl@1.1/include
+    extra-lib-dirs: /opt/homebrew/opt/openssl@1.1/lib
+
 package direct-sqlcipher
     extra-include-dirs: /opt/homebrew/opt/openssl@1.1/include
     extra-lib-dirs: /opt/homebrew/opt/openssl@1.1/lib
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 157d7cea2..28b4c5112 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1922,10 +1922,10 @@ processChatCommand = \case
   DeleteRemoteHost rh -> deleteRemoteHost rh >> ok_
   StoreRemoteFile rh encrypted_ localPath -> CRRemoteFileStored rh <$> storeRemoteFile rh encrypted_ localPath
   GetRemoteFile rh rf -> getRemoteFile rh rf >> ok_
-  StartRemoteCtrl -> withUser_ $ startRemoteCtrl (execChatCommand Nothing) >> ok_
-  RegisterRemoteCtrl oob -> withUser_ $ CRRemoteCtrlRegistered <$> withStore' (`insertRemoteCtrl` oob)
-  AcceptRemoteCtrl rc -> withUser_ $ acceptRemoteCtrl rc >> ok_
-  RejectRemoteCtrl rc -> withUser_ $ rejectRemoteCtrl rc >> ok_
+  ConnectRemoteCtrl oob -> withUser_ $ CRRemoteCtrlRegistered <$> withStore' (`insertRemoteCtrl` oob)
+  FindKnownRemoteCtrl -> withUser_ $ findKnownRemoteCtrl (execChatCommand Nothing) >> ok_
+  ConfirmRemoteCtrl rc -> withUser_ $ confirmRemoteCtrl rc >> ok_
+  VerifyRemoteCtrlSession rc sessId -> withUser_ $ verifyRemoteCtrlSession rc sessId >> ok_
   StopRemoteCtrl -> withUser_ $ stopRemoteCtrl >> ok_
   ListRemoteCtrls -> withUser_ $ CRRemoteCtrlList <$> listRemoteCtrls
   DeleteRemoteCtrl rc -> withUser_ $ deleteRemoteCtrl rc >> ok_
@@ -5798,14 +5798,14 @@ chatCommandP =
       "/sync " *> char_ '@' *> (SyncContactRatchet <$> displayName <*> (" force=on" $> True <|> pure False)),
       "/_get code @" *> (APIGetContactCode <$> A.decimal),
       "/_get code #" *> (APIGetGroupMemberCode <$> A.decimal <* A.space <*> A.decimal),
-      "/_verify code @" *> (APIVerifyContact <$> A.decimal <*> optional (A.space *> textP)),
-      "/_verify code #" *> (APIVerifyGroupMember <$> A.decimal <* A.space <*> A.decimal <*> optional (A.space *> textP)),
+      "/_verify code @" *> (APIVerifyContact <$> A.decimal <*> optional (A.space *> verifyCodeP)),
+      "/_verify code #" *> (APIVerifyGroupMember <$> A.decimal <* A.space <*> A.decimal <*> optional (A.space *> verifyCodeP)),
       "/_enable @" *> (APIEnableContact <$> A.decimal),
       "/_enable #" *> (APIEnableGroupMember <$> A.decimal <* A.space <*> A.decimal),
       "/code " *> char_ '@' *> (GetContactCode <$> displayName),
       "/code #" *> (GetGroupMemberCode <$> displayName <* A.space <* char_ '@' <*> displayName),
-      "/verify " *> char_ '@' *> (VerifyContact <$> displayName <*> optional (A.space *> textP)),
-      "/verify #" *> (VerifyGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> optional (A.space *> textP)),
+      "/verify " *> char_ '@' *> (VerifyContact <$> displayName <*> optional (A.space *> verifyCodeP)),
+      "/verify #" *> (VerifyGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> optional (A.space *> verifyCodeP)),
       "/enable " *> char_ '@' *> (EnableContact <$> displayName),
       "/enable #" *> (EnableGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName),
       ("/help files" <|> "/help file" <|> "/hf") $> ChatHelp HSFiles,
@@ -5856,7 +5856,7 @@ chatCommandP =
       "/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
       "/_connect " *> (APIAddContact <$> A.decimal <*> incognitoOnOffP),
       "/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP),
-      ("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
+      ("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeTill isSpace $> Nothing)),
       ("/connect" <|> "/c") *> (AddContact <$> incognitoP),
       SendMessage <$> chatNameP <* A.space <*> msgTextP,
       "@#" *> (SendMemberContactMessage <$> displayName <* A.space <* char_ '@' <*> displayName <* A.space <*> msgTextP),
@@ -5926,12 +5926,11 @@ chatCommandP =
       "/delete remote host " *> (DeleteRemoteHost <$> A.decimal),
       "/store remote file " *> (StoreRemoteFile <$> A.decimal <*> optional (" encrypt=" *> onOffP) <* A.space <*> filePath),
       "/get remote file " *> (GetRemoteFile <$> A.decimal <* A.space <*> jsonP),
-      "/start remote ctrl" $> StartRemoteCtrl,
-      "/register remote ctrl " *> (RegisterRemoteCtrl <$> strP),
-      -- "/_register remote ctrl " *> (RegisterRemoteCtrl <$> jsonP),
+      "/connect remote ctrl " *> (ConnectRemoteCtrl <$> strP),
+      "/find remote ctrl" $> FindKnownRemoteCtrl,
+      "/confirm remote ctrl " *> (ConfirmRemoteCtrl <$> A.decimal),
+      "/verify remote ctrl " *> (VerifyRemoteCtrlSession <$> A.decimal <* A.space <*> textP),
       "/list remote ctrls" $> ListRemoteCtrls,
-      "/accept remote ctrl " *> (AcceptRemoteCtrl <$> A.decimal),
-      "/reject remote ctrl " *> (RejectRemoteCtrl <$> A.decimal),
       "/stop remote ctrl" $> StopRemoteCtrl,
       "/delete remote ctrl " *> (DeleteRemoteCtrl <$> A.decimal),
       ("/quit" <|> "/q" <|> "/exit") $> QuitChat,
@@ -5997,6 +5996,7 @@ chatCommandP =
     fullNameP = A.space *> textP <|> pure ""
     textP = safeDecodeUtf8 <$> A.takeByteString
     pwdP = jsonP <|> (UserPwd . safeDecodeUtf8 <$> A.takeTill (== ' '))
+    verifyCodeP = safeDecodeUtf8 <$> A.takeWhile (\c -> isDigit c || c == ' ')
     msgTextP = jsonP <|> textP
     stringP = T.unpack . safeDecodeUtf8 <$> A.takeByteString
     filePath = stringP
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 25fe9294c..77976da05 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -426,11 +426,11 @@ data ChatCommand
   | DeleteRemoteHost RemoteHostId -- ^ Unregister remote host and remove its data
   | StoreRemoteFile {remoteHostId :: RemoteHostId, storeEncrypted :: Maybe Bool, localPath :: FilePath}
   | GetRemoteFile {remoteHostId :: RemoteHostId, file :: RemoteFile}
-  | StartRemoteCtrl -- ^ Start listening for announcements from all registered controllers
-  | RegisterRemoteCtrl SignedOOB -- ^ Register OOB data for remote controller discovery and handshake
+  | ConnectRemoteCtrl SignedOOB -- ^ Connect new or existing controller via OOB data
+  | FindKnownRemoteCtrl -- ^ Start listening for announcements from all existing controllers
+  | ConfirmRemoteCtrl RemoteCtrlId -- ^ Confirm the connection with found controller
+  | VerifyRemoteCtrlSession RemoteCtrlId Text -- ^ Verify remote controller session
   | ListRemoteCtrls
-  | AcceptRemoteCtrl RemoteCtrlId -- ^ Accept discovered data and store confirmation
-  | RejectRemoteCtrl RemoteCtrlId -- ^ Reject and blacklist discovered data
   | StopRemoteCtrl -- ^ Stop listening for announcements or terminate an active session
   | DeleteRemoteCtrl RemoteCtrlId -- ^ Remove all local data associated with a remote controller session
   | QuitChat
@@ -458,11 +458,11 @@ allowRemoteCommand = \case
   GetRemoteFile {} -> False
   StopRemoteHost _ -> False
   DeleteRemoteHost _ -> False
-  RegisterRemoteCtrl {} -> False
-  StartRemoteCtrl -> False
+  ConnectRemoteCtrl {} -> False
+  FindKnownRemoteCtrl -> False
+  ConfirmRemoteCtrl _ -> False
+  VerifyRemoteCtrlSession {} -> False
   ListRemoteCtrls -> False
-  AcceptRemoteCtrl _ -> False
-  RejectRemoteCtrl _ -> False
   StopRemoteCtrl -> False
   DeleteRemoteCtrl _ -> False
   ExecChatStoreSQL _ -> False
@@ -641,14 +641,16 @@ data ChatResponse
   | CRRemoteHostCreated {remoteHost :: RemoteHostInfo}
   | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
   | CRRemoteHostStarted {remoteHost :: RemoteHostInfo, sessionOOB :: Text}
+  | CRRemoteHostSessionCode {remoteHost :: RemoteHostInfo, sessionCode :: Text}
   | CRRemoteHostConnected {remoteHost :: RemoteHostInfo}
   | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
   | CRRemoteFileStored {remoteHostId :: RemoteHostId, remoteFileSource :: CryptoFile}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
-  | CRRemoteCtrlRegistered {remoteCtrl :: RemoteCtrlInfo}
-  | CRRemoteCtrlAnnounce {fingerprint :: C.KeyHash} -- unregistered fingerprint, needs confirmation
+  | 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}
+  | CRRemoteCtrlConnecting {remoteCtrl :: RemoteCtrlInfo} -- TODO is remove
+  | CRRemoteCtrlSessionCode {remoteCtrl :: RemoteCtrlInfo, sessionCode :: Text, newCtrl :: Bool}
   | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo}
   | CRRemoteCtrlStopped
   | CRSQLResult {rows :: [Text]}
@@ -679,8 +681,9 @@ allowRemoteEvent = \case
   CRRemoteCtrlAnnounce {} -> False
   CRRemoteCtrlFound {} -> False
   CRRemoteCtrlConnecting {} -> False
+  CRRemoteCtrlSessionCode {} -> False
   CRRemoteCtrlConnected {} -> False
-  CRRemoteCtrlStopped {} -> False
+  CRRemoteCtrlStopped -> False
   _ -> True
 
 logResponseToFile :: ChatResponse -> Bool
@@ -1060,6 +1063,7 @@ data RemoteCtrlError
   | RCECertificateExpired {remoteCtrlId :: RemoteCtrlId} -- ^ A connection or CA certificate in a chain have bad validity period
   | RCECertificateUntrusted {remoteCtrlId :: RemoteCtrlId} -- ^ TLS is unable to validate certificate chain presented for a connection
   | RCEBadFingerprint -- ^ Bad fingerprint data provided in OOB
+  | RCEBadVerificationCode -- ^ The code submitted doesn't match session TLSunique
   | RCEHTTP2Error {http2Error :: String}
   | RCEHTTP2RespStatus {statusCode :: Maybe Int} -- TODO remove
   | RCEInvalidResponse {responseError :: String}
@@ -1071,13 +1075,14 @@ data ArchiveError
   | AEImportFile {file :: String, chatError :: ChatError}
   deriving (Show, Exception)
 
+-- | Host (mobile) side of transport to process remote commands and forward notifications
 data RemoteCtrlSession = RemoteCtrlSession
-  { -- | Host (mobile) side of transport to process remote commands and forward notifications
-    discoverer :: Async (),
-    supervisor :: Async (),
-    hostServer :: Maybe (Async ()),
-    discovered :: TMap C.KeyHash (TransportHost, Word16),
-    accepted :: TMVar RemoteCtrlId,
+  { discoverer :: Async (), -- multicast listener
+    supervisor :: Async (), -- session state/subprocess supervisor
+    hostServer :: Maybe (Async ()), -- a running session
+    discovered :: TMap C.KeyHash (TransportHost, Word16), -- multicast-announced services
+    confirmed :: TMVar RemoteCtrlId, -- connection fingerprint found/stored in DB
+    verified :: TMVar (RemoteCtrlId, Text), -- user confirmed the session
     remoteOutputQ :: TBQueue ChatResponse
   }
 
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index cc3eb9f19..cb943ac2c 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -7,7 +8,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
-
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Chat.Remote where
@@ -41,7 +41,7 @@ import Simplex.Chat.Controller
 import Simplex.Chat.Files
 import Simplex.Chat.Messages (chatNameStr)
 import Simplex.Chat.Remote.Protocol
-import Simplex.Chat.Remote.RevHTTP (announceRevHTTP2, connectRevHTTP2)
+import Simplex.Chat.Remote.RevHTTP (announceRevHTTP2, attachHTTP2Server)
 import Simplex.Chat.Remote.Transport
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store.Files
@@ -56,6 +56,7 @@ import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding (smpDecode)
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Transport (tlsUniq)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
@@ -65,6 +66,7 @@ import qualified Simplex.RemoteControl.Discovery as Discovery
 import Simplex.RemoteControl.Types
 import System.FilePath (takeFileName, (</>))
 import UnliftIO
+import UnliftIO.Concurrent (threadDelay)
 import UnliftIO.Directory (copyFile, createDirectoryIfMissing, renameFile)
 
 -- * Desktop side
@@ -93,13 +95,15 @@ startRemoteHost rhId = do
   rh <- withStore (`getRemoteHost` rhId)
   tasks <- startRemoteHostSession rh
   logInfo $ "Remote host session starting for " <> tshow rhId
-  asyncRegistered tasks $ run rh tasks `catchAny` \err -> do
-    logError $ "Remote host session startup failed for " <> tshow rhId <> ": " <> tshow err
-    cancelTasks tasks
-    chatModifyVar remoteHostSessions $ M.delete rhId
-    throwError $ fromMaybe (mkChatError err) $ fromException err
-  -- logInfo $ "Remote host session starting for " <> tshow rhId
+  asyncRegistered tasks $
+    run rh tasks `catchAny` \err -> do
+      logError $ "Remote host session startup failed for " <> tshow rhId <> ": " <> tshow err
+      cancelTasks tasks
+      chatModifyVar remoteHostSessions $ M.delete rhId
+      throwError $ fromMaybe (mkChatError err) $ fromException err
   where
+    -- logInfo $ "Remote host session starting for " <> tshow rhId
+
     run :: ChatMonad m => RemoteHost -> Tasks -> m ()
     run rh@RemoteHost {storePath} tasks = do
       (fingerprint, credentials) <- liftIO $ genSessionCredentials rh
@@ -109,7 +113,7 @@ startRemoteHost rhId = do
         chatModifyVar currentRemoteHost $ \cur -> if cur == Just rhId then Nothing else cur -- only wipe the closing RH
         withRemoteHostSession rhId $ \sessions _ -> Right <$> TM.delete rhId sessions
         toView (CRRemoteHostStopped rhId) -- only signal "stopped" when the session is unregistered cleanly
-      -- block until some client is connected or an error happens
+        -- block until some client is connected or an error happens
       logInfo $ "Remote host session connecting for " <> tshow rhId
       rcName <- chatReadVar localDeviceName
       localAddr <- asks multicastSubscribers >>= Discovery.getLocalAddress >>= maybe (throwError . ChatError $ CEInternalError "unable to get local address") pure
@@ -127,12 +131,14 @@ startRemoteHost rhId = do
       logInfo $ "Remote host session started for " <> tshow rhId
       chatModifyVar remoteHostSessions $ M.adjust (\rhs -> rhs {remoteHostClient = Just remoteHostClient}) rhId
       chatWriteVar currentRemoteHost $ Just rhId
-      toView $ CRRemoteHostConnected RemoteHostInfo
-        { remoteHostId = rhId,
-          storePath = storePath,
-          displayName = hostDeviceName remoteHostClient,
-          sessionActive = True
-        }
+      toView $
+        CRRemoteHostConnected
+          RemoteHostInfo
+            { remoteHostId = rhId,
+              storePath = storePath,
+              displayName = hostDeviceName remoteHostClient,
+              sessionActive = True
+            }
 
     genSessionCredentials RemoteHost {caKey, caCert} = do
       sessionCreds <- genCredentials (Just parent) (0, 24) "Session"
@@ -251,34 +257,48 @@ liftRH rhId = liftError (ChatErrorRemoteHost rhId . RHProtocolError)
 
 -- * Mobile side
 
-startRemoteCtrl :: forall m . ChatMonad m => (ByteString -> m ChatResponse) -> m ()
-startRemoteCtrl execChatCommand = do
+findKnownRemoteCtrl :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> m ()
+findKnownRemoteCtrl execChatCommand = do
   logInfo "Starting remote host"
   checkNoRemoteCtrlSession -- tiny race with the final @chatWriteVar@ until the setup finishes and supervisor spawned
   discovered <- newTVarIO mempty
   discoverer <- async $ discoverRemoteCtrls discovered -- TODO extract to a controller service singleton
   size <- asks $ tbqSize . config
   remoteOutputQ <- newTBQueueIO size
-  accepted <- newEmptyTMVarIO
-  supervisor <- async $ runHost discovered accepted $ handleRemoteCommand execChatCommand remoteOutputQ
-  chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted, remoteOutputQ}
+  confirmed <- newEmptyTMVarIO
+  verified <- newEmptyTMVarIO
+  supervisor <- async $ do
+    threadDelay 500000 -- give chat controller a chance to reply with "ok" to prevent flaking tests
+    runHost discovered confirmed verified $ handleRemoteCommand execChatCommand remoteOutputQ
+  chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, confirmed, verified, remoteOutputQ}
 
 -- | Track remote host lifecycle in controller session state and signal UI on its progress
-runHost :: ChatMonad m => TM.TMap C.KeyHash (TransportHost, Word16) -> TMVar RemoteCtrlId -> (HTTP2Request -> m ()) -> m ()
-runHost discovered accepted handleHttp = do
-  remoteCtrlId <- atomically (readTMVar accepted) -- wait for ???
+runHost :: ChatMonad m => TM.TMap C.KeyHash (TransportHost, Word16) -> TMVar RemoteCtrlId -> TMVar (RemoteCtrlId, Text) -> (HTTP2Request -> m ()) -> m ()
+runHost discovered confirmed verified handleHttp = do
+  remoteCtrlId <- atomically (readTMVar confirmed) -- wait for discoverRemoteCtrls.process or confirmRemoteCtrl to confirm fingerprint as a known RC
   rc@RemoteCtrl {fingerprint} <- withStore (`getRemoteCtrl` remoteCtrlId)
   serviceAddress <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure -- wait for location of the matching fingerprint
   toView $ CRRemoteCtrlConnecting $ remoteCtrlInfo rc False
   atomically $ writeTVar discovered mempty -- flush unused sources
-  server <- async $ connectRevHTTP2 serviceAddress fingerprint handleHttp -- spawn server for remote protocol commands
+  server <- async $
+    -- spawn server for remote protocol commands
+    Discovery.connectTLSClient serviceAddress fingerprint $ \tls -> do
+      let sessionCode = decodeUtf8 . strEncode $ tlsUniq tls
+      toView $ CRRemoteCtrlSessionCode {remoteCtrl = remoteCtrlInfo rc True, sessionCode, newCtrl = False}
+      userInfo <- atomically $ readTMVar verified
+      if userInfo == (remoteCtrlId, sessionCode)
+        then do
+          toView $ CRRemoteCtrlConnected $ remoteCtrlInfo rc True
+          attachHTTP2Server handleHttp tls
+        else do
+          toView $ CRChatCmdError Nothing $ ChatErrorRemoteCtrl RCEBadVerificationCode
+          -- the server doesn't enter its loop and waitCatch below falls through
   chatModifyVar remoteCtrlSession $ fmap $ \s -> s {hostServer = Just server}
-  toView $ CRRemoteCtrlConnected $ remoteCtrlInfo rc True
   _ <- waitCatch server -- wait for the server to finish
   chatWriteVar remoteCtrlSession Nothing
   toView CRRemoteCtrlStopped
 
-handleRemoteCommand :: forall m . ChatMonad m => (ByteString -> m ChatResponse) -> TBQueue ChatResponse -> HTTP2Request -> m ()
+handleRemoteCommand :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> TBQueue ChatResponse -> HTTP2Request -> m ()
 handleRemoteCommand execChatCommand remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
   logDebug "handleRemoteCommand"
   liftRC (tryRemoteError parseRequest) >>= \case
@@ -358,7 +378,7 @@ handleStoreFile fileName fileSize fileDigest getChunk =
       pure filePath
 
 handleGetFile :: ChatMonad m => User -> RemoteFile -> Respond m -> m ()
-handleGetFile User {userId} RemoteFile{userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do
+handleGetFile User {userId} RemoteFile {userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do
   logDebug $ "GetFile: " <> tshow filePath
   unless (userId == commandUserId) $ throwChatError $ CEDifferentActiveUser {commandUserId, activeUserId = userId}
   path <- maybe filePath (</> filePath) <$> chatReadVar filesFolder
@@ -385,7 +405,7 @@ discoverRemoteCtrls discovered = do
           Left _ -> receive sock -- TODO it is probably better to report errors to view here
         _nonV4 -> receive sock
 
-    process sock (sockAddr, Announce {caFingerprint, serviceAddress=(annAddr, port)}) = do
+    process sock (sockAddr, Announce {caFingerprint, serviceAddress = (annAddr, port)}) = do
       unless (annAddr == sockAddr) $ logError "Announced address doesn't match socket address"
       let addr = THIPv4 (hostAddressToTuple sockAddr)
       ifM
@@ -406,13 +426,13 @@ discoverRemoteCtrls discovered = do
           Just True ->
             chatReadVar remoteCtrlSession >>= \case
               Nothing -> toView . CRChatError Nothing . ChatError $ CEInternalError "Remote host found without running a session"
-              Just RemoteCtrlSession {accepted} -> atomically $ void $ tryPutTMVar accepted remoteCtrlId -- previously accepted controller, connect automatically
+              Just RemoteCtrlSession {confirmed} -> atomically $ void $ tryPutTMVar confirmed remoteCtrlId -- previously accepted controller, connect automatically
 
 listRemoteCtrls :: ChatMonad m => m [RemoteCtrlInfo]
 listRemoteCtrls = do
   active <-
-    chatReadVar remoteCtrlSession
-      $>>= \RemoteCtrlSession {accepted} -> atomically $ tryReadTMVar accepted
+    chatReadVar remoteCtrlSession $>>= \RemoteCtrlSession {confirmed} ->
+      atomically $ tryReadTMVar confirmed
   map (rcInfo active) <$> withStore' getRemoteCtrls
   where
     rcInfo activeRcId rc@RemoteCtrl {remoteCtrlId} =
@@ -422,19 +442,17 @@ remoteCtrlInfo :: RemoteCtrl -> Bool -> RemoteCtrlInfo
 remoteCtrlInfo RemoteCtrl {remoteCtrlId, displayName, fingerprint, accepted} sessionActive =
   RemoteCtrlInfo {remoteCtrlId, displayName, fingerprint, accepted, sessionActive}
 
-acceptRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
-acceptRemoteCtrl rcId = do
+confirmRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
+confirmRemoteCtrl rcId = do
   -- TODO check it exists, check the ID is the same as in session
-  RemoteCtrlSession {accepted} <- getRemoteCtrlSession
+  RemoteCtrlSession {confirmed} <- getRemoteCtrlSession
   withStore' $ \db -> markRemoteCtrlResolution db rcId True
-  atomically . void $ tryPutTMVar accepted rcId -- the remote host can now proceed with connection
+  atomically . void $ tryPutTMVar confirmed rcId -- the remote host can now proceed with connection
 
-rejectRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
-rejectRemoteCtrl rcId = do
-  withStore' $ \db -> markRemoteCtrlResolution db rcId False
-  RemoteCtrlSession {discoverer, supervisor} <- getRemoteCtrlSession
-  cancel discoverer
-  cancel supervisor
+verifyRemoteCtrlSession :: ChatMonad m => RemoteCtrlId -> Text -> m ()
+verifyRemoteCtrlSession rcId sessId = do
+  RemoteCtrlSession {verified} <- getRemoteCtrlSession
+  void . atomically $ tryPutTMVar verified (rcId, sessId)
 
 stopRemoteCtrl :: ChatMonad m => m ()
 stopRemoteCtrl = do
diff --git a/src/Simplex/Chat/Remote/RevHTTP.hs b/src/Simplex/Chat/Remote/RevHTTP.hs
index c6c777596..08c844dcf 100644
--- a/src/Simplex/Chat/Remote/RevHTTP.hs
+++ b/src/Simplex/Chat/Remote/RevHTTP.hs
@@ -11,11 +11,9 @@ module Simplex.Chat.Remote.RevHTTP where
 import Simplex.RemoteControl.Discovery
 import Simplex.RemoteControl.Types
 import Control.Logger.Simple
-import Data.Word (Word16)
 import qualified Network.TLS as TLS
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Transport as Transport
-import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.HTTP2 (defaultHTTP2BufferSize, getHTTP2Body)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError (..), attachHTTP2Client, bodyHeadSize, connTimeout, defaultHTTP2ClientConfig)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..), runHTTP2ServerWith)
@@ -39,9 +37,6 @@ runHTTP2Client finishedVar clientVar tls =
     -- TODO connection timeout
     config = defaultHTTP2ClientConfig {bodyHeadSize = doNotPrefetchHead, connTimeout = maxBound}
 
-connectRevHTTP2 :: (MonadUnliftIO m) => (TransportHost, Word16) -> C.KeyHash -> (HTTP2Request -> m ()) -> m ()
-connectRevHTTP2 serviceAddress fingerprint = connectTLSClient serviceAddress fingerprint . attachHTTP2Server
-
 attachHTTP2Server :: (MonadUnliftIO m) => (HTTP2Request -> m ()) -> Transport.TLS -> m ()
 attachHTTP2Server processRequest tls = do
   withRunInIO $ \unlift ->
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index ed4b768cd..8779480a5 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -275,17 +275,26 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRRemoteHostCreated RemoteHostInfo {remoteHostId} -> ["remote host " <> sShow remoteHostId <> " created"]
   CRRemoteHostList hs -> viewRemoteHosts hs
   CRRemoteHostStarted {remoteHost = RemoteHostInfo {remoteHostId = rhId}, sessionOOB} -> ["remote host " <> sShow rhId <> " started", "connection code:", plain sessionOOB]
+  CRRemoteHostSessionCode {remoteHost = RemoteHostInfo {remoteHostId = rhId}, sessionCode} ->
+    ["remote host " <> sShow rhId <> " is connecting", "Compare session code with host:", plain sessionCode]
   CRRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} -> ["remote host " <> sShow rhId <> " connected"]
   CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
   CRRemoteFileStored rhId (CryptoFile filePath cfArgs_) ->
     [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, displayName = rcName} -> ["remote controller " <> sShow rcId <> " connecting to " <> plain rcName]
-  CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, displayName = rcName} -> ["remote controller " <> sShow rcId <> " connected, " <> plain rcName]
+  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, displayName = rcName} ->
+    ["remote controller " <> sShow rcId <> " connecting to " <> plain rcName]
+  CRRemoteCtrlSessionCode {remoteCtrl = RemoteCtrlInfo {remoteCtrlId = rcId, displayName = rcName}, sessionCode} ->
+    ["remote controller " <> sShow rcId <> " connected to " <> plain rcName, "Compare session code with controller and use:", "/verify remote ctrl " <> sShow rcId <> " " <> plain sessionCode]
+  CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, displayName = rcName} ->
+    ["remote controller " <> sShow rcId <> " session started with " <> plain rcName]
   CRRemoteCtrlStopped -> ["remote controller stopped"]
   CRSQLResult rows -> map plain rows
   CRSlowSQLQueries {chatQueries, agentQueries} ->
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 7c62333d6..b2e7aa5cb 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -30,7 +30,7 @@ import Simplex.Chat.Remote.Types
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
 import Simplex.Messaging.Encoding (smpDecode)
-import Simplex.Messaging.Encoding.String (strDecode, strEncode)
+import Simplex.Messaging.Encoding.String (strEncode)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Response (..), closeHTTP2Client, sendRequest)
@@ -408,7 +408,7 @@ startRemote mobile desktop = do
 
   mobile ##> "/set device name Mobile"
   mobile <## "ok"
-  mobile ##> "/start remote ctrl"
+  mobile ##> "/find remote ctrl"
   mobile <## "ok"
   mobile <## "remote controller announced"
   mobile <## "connection code:"
@@ -416,13 +416,20 @@ startRemote mobile desktop = do
   -- The user scans OOB QR code and confirms it matches the announced stuff
   fromString annFingerprint `shouldBe` strEncode oobFingerprint
 
-  mobile ##> ("/register remote ctrl " <> oobLink)
+  mobile ##> ("/connect remote ctrl " <> oobLink)
   mobile <## "remote controller 1 registered"
-  mobile ##> "/accept remote ctrl 1"
-  mobile <## "ok" -- alternative scenario: accepted before controller start
+  mobile ##> "/confirm remote ctrl 1"
+  mobile <## "ok"
   mobile <## "remote controller 1 connecting to My desktop"
-  mobile <## "remote controller 1 connected, My desktop"
-  desktop <## "remote host 1 connected"
+  -- TODO: rework tls connection prelude
+  mobile <## "remote controller 1 connected to My desktop"
+  mobile <## "Compare session code with controller and use:"
+  verifyCmd <- getTermLine mobile
+  mobile ##> verifyCmd
+  mobile <## "ok"
+  concurrently_
+    (mobile <## "remote controller 1 session started with My desktop")
+    (desktop <## "remote host 1 connected")
 
 contactBob :: TestCC -> TestCC -> IO ()
 contactBob desktop bob = do

From 0cc26d192d5a0f94338ee1584b2e38311d613b4d Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 2 Nov 2023 14:07:51 +0000
Subject: [PATCH 28/69] update sha256map.nix

---
 scripts/nix/sha256map.nix | 2 +-
 stack.yaml                | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 680b92075..9b8d3d5f4 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."e9b5a849ab18de085e8c69d239a9706b99bcf787" = "0b50mlnzwian4l9kx4niwnj9qkyp21ryc8x9d3il9jkdfxrx8kqi";
+  "https://github.com/simplex-chat/simplexmq.git"."a5fed340e2814a226180ce1abe606ac79366fe5b" = "18sj1499rfb35wsgb9gbr3q99flhw650jm0wnn1iw42m9f17vwbn";
   "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" = "0kiwhvml42g9anw4d2v0zd1fpc790pj9syg5x3ik4l97fnkbbwpp";
diff --git a/stack.yaml b/stack.yaml
index da69b9e90..fe6771b5c 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: e9b5a849ab18de085e8c69d239a9706b99bcf787
+    commit: a5fed340e2814a226180ce1abe606ac79366fe5b
   - github: kazu-yamamoto/http2
     commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
   # - ../direct-sqlcipher

From 177112ab18f43278e2f4173e61d0f9420a4da286 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 4 Nov 2023 19:04:40 +0000
Subject: [PATCH 29/69] update simplexmq

---
 cabal.project             |  2 +-
 package.yaml              |  2 +-
 scripts/nix/sha256map.nix |  2 +-
 simplex-chat.cabal        | 14 +++++++-------
 stack.yaml                |  2 +-
 5 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/cabal.project b/cabal.project
index d87f7aca1..e201ebc32 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: a5fed340e2814a226180ce1abe606ac79366fe5b
+    tag: 1a0c4b73de5cda4ac6765dd47e0199238e498d5f
 
 source-repository-package
     type: git
diff --git a/package.yaml b/package.yaml
index 2bfb36d18..2166f0c9e 100644
--- a/package.yaml
+++ b/package.yaml
@@ -31,7 +31,7 @@ dependencies:
   - exceptions == 0.10.*
   - filepath == 1.4.*
   - http-types == 0.12.*
-  - http2 == 4.1.*
+  - http2 >= 4.2.2 && < 4.3
   - memory == 0.18.*
   - mtl == 2.3.*
   - network >= 3.1.2.7 && < 3.2
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 9b8d3d5f4..ce443e2c3 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."a5fed340e2814a226180ce1abe606ac79366fe5b" = "18sj1499rfb35wsgb9gbr3q99flhw650jm0wnn1iw42m9f17vwbn";
+  "https://github.com/simplex-chat/simplexmq.git"."1a0c4b73de5cda4ac6765dd47e0199238e498d5f" = "12xpr2lxw9rr3v2bz5m5g9bb0kj7c5yyan47w0nnp52gzfs4pff0";
   "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" = "0kiwhvml42g9anw4d2v0zd1fpc790pj9syg5x3ik4l97fnkbbwpp";
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 2dc77c3c2..5b2a59e29 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -179,7 +179,7 @@ library
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2 ==4.1.*
+    , http2 >=4.2.2 && <4.3
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -231,7 +231,7 @@ executable simplex-bot
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2 ==4.1.*
+    , http2 >=4.2.2 && <4.3
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -284,7 +284,7 @@ executable simplex-bot-advanced
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2 ==4.1.*
+    , http2 >=4.2.2 && <4.3
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -339,7 +339,7 @@ executable simplex-broadcast-bot
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2 ==4.1.*
+    , http2 >=4.2.2 && <4.3
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -393,7 +393,7 @@ executable simplex-chat
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2 ==4.1.*
+    , http2 >=4.2.2 && <4.3
     , memory ==0.18.*
     , mtl ==2.3.*
     , network ==3.1.*
@@ -451,7 +451,7 @@ executable simplex-directory-service
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
-    , http2 ==4.1.*
+    , http2 >=4.2.2 && <4.3
     , memory ==0.18.*
     , mtl ==2.3.*
     , network >=3.1.2.7 && <3.2
@@ -535,7 +535,7 @@ test-suite simplex-chat-test
     , generic-random ==1.5.*
     , hspec ==2.11.*
     , http-types ==0.12.*
-    , http2 ==4.1.*
+    , http2 >=4.2.2 && <4.3
     , memory ==0.18.*
     , mtl ==2.3.*
     , network ==3.1.*
diff --git a/stack.yaml b/stack.yaml
index fe6771b5c..9043a5695 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: a5fed340e2814a226180ce1abe606ac79366fe5b
+    commit: 1a0c4b73de5cda4ac6765dd47e0199238e498d5f
   - github: kazu-yamamoto/http2
     commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
   # - ../direct-sqlcipher

From b72914477375c917efe406339a20ec9c7c7d4781 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Wed, 8 Nov 2023 22:13:52 +0200
Subject: [PATCH 30/69] core: use xrcp protocol for desktop/mobile connection
 (#3305)

* WIP: start working on /connect remote ctrl

OOB is broken, requires fixing simplexmq bits.

* WIP: pull CtrlCryptoHandle from xrcp

* place xrcp stubs

* WIP: start switching to RemoteControl.Client types

* fix http2 sha

* fix sha256map.nix

* fix cabal.project

* update RC test

* WIP: add new remote session

* fix compilation

* simplify

* attach HTTP2 server to TLS

* starting host session in controller (WIP)

* more WIP

* compiles

* compiles2

* wip

* pass startRemote' test

* async to poll for events from host, test to send messages fails

* move xrcp handshake test to simplexmq

* detect session stops

* fix connectRemoteCtrl

* use step type

* app info

* WIP: pairing stores

* plug in hello/appInfo/pairings

* negotiate app version

* update simplexmw, remove KEM secrets from DB

* fix file tests

* tone down http2 shutdown errors

* Add stored session test

* bump simplexmq tag

* update simplexmq

* refactor, fix

* removed unused errors

* rename fields, remove unused file

* rename errors

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 cabal.project                                 |   2 +-
 scripts/nix/sha256map.nix                     |   2 +-
 simplex-chat.cabal                            |   1 +
 src/Simplex/Chat.hs                           |  44 +-
 src/Simplex/Chat/Controller.hs                | 106 ++--
 .../Migrations/M20231114_remote_controller.hs |  32 +-
 src/Simplex/Chat/Migrations/chat_schema.sql   |  32 +-
 src/Simplex/Chat/Remote.hs                    | 527 ++++++++++--------
 src/Simplex/Chat/Remote/AppVersion.hs         |  69 +++
 src/Simplex/Chat/Remote/Protocol.hs           |  18 +-
 src/Simplex/Chat/Remote/RevHTTP.hs            |  29 +-
 src/Simplex/Chat/Remote/Types.hs              |  83 +--
 src/Simplex/Chat/Store/Remote.hs              | 120 +++-
 src/Simplex/Chat/Store/Shared.hs              |   3 +
 src/Simplex/Chat/View.hs                      |  43 +-
 stack.yaml                                    |   2 +-
 tests/ChatClient.hs                           |   2 +-
 tests/RemoteTests.hs                          | 227 +++-----
 18 files changed, 761 insertions(+), 581 deletions(-)
 create mode 100644 src/Simplex/Chat/Remote/AppVersion.hs

diff --git a/cabal.project b/cabal.project
index 1c149d201..fe74d2148 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: 1a0c4b73de5cda4ac6765dd47e0199238e498d5f
+    tag: 102487bc4fbb865aac4207d2ba6f2ea77eff3290
 
 source-repository-package
     type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 3e3df9fdb..26f7357a1 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."1a0c4b73de5cda4ac6765dd47e0199238e498d5f" = "12xpr2lxw9rr3v2bz5m5g9bb0kj7c5yyan47w0nnp52gzfs4pff0";
+  "https://github.com/simplex-chat/simplexmq.git"."102487bc4fbb865aac4207d2ba6f2ea77eff3290" = "1zay63ix9vh20p6843l1zry47zwb7lkirmxrrgdcc7qwl89js1bs";
   "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/simplex-chat.cabal b/simplex-chat.cabal
index 32711d385..ba5297e69 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -131,6 +131,7 @@ library
       Simplex.Chat.ProfileGenerator
       Simplex.Chat.Protocol
       Simplex.Chat.Remote
+      Simplex.Chat.Remote.AppVersion
       Simplex.Chat.Remote.Multicast
       Simplex.Chat.Remote.Protocol
       Simplex.Chat.Remote.RevHTTP
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index b9663bae1..664661603 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -46,7 +46,7 @@ import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
+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)
@@ -72,7 +72,6 @@ import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Groups
 import Simplex.Chat.Store.Messages
 import Simplex.Chat.Store.Profiles
-import Simplex.Chat.Store.Remote
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
@@ -376,8 +375,8 @@ restoreCalls = do
 
 stopChatController :: forall m. MonadUnliftIO m => ChatController -> m ()
 stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags, remoteHostSessions, remoteCtrlSession} = do
-  readTVarIO remoteHostSessions >>= mapM_ cancelRemoteHostSession
-  readTVarIO remoteCtrlSession >>= mapM_ cancelRemoteCtrlSession_
+  readTVarIO remoteHostSessions >>= mapM_ (liftIO . cancelRemoteHost)
+  atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl)
   disconnectAgentClient smpAgent
   readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2)
   closeFiles sndFiles
@@ -409,7 +408,7 @@ execChatCommand_ :: ChatMonad' m => Maybe User -> ChatCommand -> m ChatResponse
 execChatCommand_ u cmd = handleCommandError u $ processChatCommand cmd
 
 execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> ChatCommand -> ByteString -> m ChatResponse
-execRemoteCommand u rhId cmd s = handleCommandError u $ getRemoteHostSession rhId >>= \rh -> processRemoteCommand rhId rh cmd s
+execRemoteCommand u rhId cmd s = handleCommandError u $ getRemoteHostClient rhId >>= \rh -> processRemoteCommand rhId rh cmd s
 
 handleCommandError :: ChatMonad' m => Maybe User -> ExceptT ChatError m ChatResponse -> m ChatResponse
 handleCommandError u a = either (CRChatCmdError u) id <$> (runExceptT a `E.catch` (pure . Left . mkChatError))
@@ -1953,17 +1952,18 @@ processChatCommand = \case
     updateGroupProfileByName gName $ \p ->
       p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
   SetLocalDeviceName name -> withUser_ $ chatWriteVar localDeviceName name >> ok_
-  CreateRemoteHost -> CRRemoteHostCreated <$> createRemoteHost
-  ListRemoteHosts -> CRRemoteHostList <$> listRemoteHosts
-  StartRemoteHost rh -> startRemoteHost rh >> ok_
-  StopRemoteHost rh -> closeRemoteHostSession rh >> ok_
-  DeleteRemoteHost rh -> deleteRemoteHost rh >> ok_
-  StoreRemoteFile rh encrypted_ localPath -> CRRemoteFileStored rh <$> storeRemoteFile rh encrypted_ localPath
-  GetRemoteFile rh rf -> getRemoteFile rh rf >> ok_
-  ConnectRemoteCtrl oob -> withUser_ $ CRRemoteCtrlRegistered <$> withStore' (`insertRemoteCtrl` oob)
-  FindKnownRemoteCtrl -> withUser_ $ findKnownRemoteCtrl (execChatCommand Nothing) >> ok_
+  ListRemoteHosts -> withUser_ $ CRRemoteHostList <$> listRemoteHosts
+  StartRemoteHost rh_ -> withUser_ $ do
+    (remoteHost_, inv) <- startRemoteHost' rh_
+    pure CRRemoteHostStarted {remoteHost_, invitation = decodeLatin1 $ strEncode inv}
+  StopRemoteHost rh_ -> withUser_ $ closeRemoteHost rh_ >> ok_
+  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_
+  FindKnownRemoteCtrl -> withUser_ $ findKnownRemoteCtrl >> ok_
   ConfirmRemoteCtrl rc -> withUser_ $ confirmRemoteCtrl rc >> ok_
-  VerifyRemoteCtrlSession rc sessId -> withUser_ $ verifyRemoteCtrlSession rc sessId >> ok_
+  VerifyRemoteCtrlSession sessId -> withUser_ $ CRRemoteCtrlConnected <$> verifyRemoteCtrlSession (execChatCommand Nothing) sessId
   StopRemoteCtrl -> withUser_ $ stopRemoteCtrl >> ok_
   ListRemoteCtrls -> withUser_ $ CRRemoteCtrlList <$> listRemoteCtrls
   DeleteRemoteCtrl rc -> withUser_ $ deleteRemoteCtrl rc >> ok_
@@ -5717,12 +5717,6 @@ waitChatStarted = do
   agentStarted <- asks agentAsync
   atomically $ readTVar agentStarted >>= \a -> unless (isJust a) retry
 
-withAgent :: ChatMonad m => (AgentClient -> ExceptT AgentErrorType m a) -> m a
-withAgent action =
-  asks smpAgent
-    >>= runExceptT . action
-    >>= liftEither . first (`ChatErrorAgent` Nothing)
-
 chatCommandP :: Parser ChatCommand
 chatCommandP =
   choice
@@ -5981,17 +5975,17 @@ chatCommandP =
       "/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))),
       ("/incognito" <* optional (A.space *> onOffP)) $> ChatHelp HSIncognito,
       "/set device name " *> (SetLocalDeviceName <$> textP),
-      "/create remote host" $> CreateRemoteHost,
+      -- "/create remote host" $> CreateRemoteHost,
       "/list remote hosts" $> ListRemoteHosts,
-      "/start remote host " *> (StartRemoteHost <$> A.decimal),
-      "/stop remote host " *> (StopRemoteHost <$> A.decimal),
+      "/start remote host " *> (StartRemoteHost <$> ("new" $> Nothing <|> (Just <$> ((,) <$> A.decimal <*> (" multicast=" *> onOffP <|> pure False))))),
+      "/stop remote host " *> (StopRemoteHost <$> ("new" $> RHNew <|> RHId <$> A.decimal)),
       "/delete remote host " *> (DeleteRemoteHost <$> A.decimal),
       "/store remote file " *> (StoreRemoteFile <$> A.decimal <*> optional (" encrypt=" *> onOffP) <* A.space <*> filePath),
       "/get remote file " *> (GetRemoteFile <$> A.decimal <* A.space <*> jsonP),
       "/connect remote ctrl " *> (ConnectRemoteCtrl <$> strP),
       "/find remote ctrl" $> FindKnownRemoteCtrl,
       "/confirm remote ctrl " *> (ConfirmRemoteCtrl <$> A.decimal),
-      "/verify remote ctrl " *> (VerifyRemoteCtrlSession <$> A.decimal <* A.space <*> textP),
+      "/verify remote ctrl " *> (VerifyRemoteCtrlSession <$> textP),
       "/list remote ctrls" $> ListRemoteCtrls,
       "/stop remote ctrl" $> StopRemoteCtrl,
       "/delete remote ctrl " *> (DeleteRemoteCtrl <$> A.decimal),
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 6ca541a71..4c38ca95d 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -16,6 +16,7 @@
 
 module Simplex.Chat.Controller where
 
+import Simplex.RemoteControl.Invitation (RCSignedInvitation)
 import Control.Concurrent (ThreadId)
 import Control.Concurrent.Async (Async)
 import Control.Exception
@@ -40,7 +41,6 @@ import Data.String
 import Data.Text (Text)
 import Data.Time (NominalDiffTime, UTCTime)
 import Data.Version (showVersion)
-import Data.Word (Word16)
 import Language.Haskell.TH (Exp, Q, runIO)
 import Numeric.Natural
 import qualified Paths_simplex_chat as SC
@@ -49,6 +49,7 @@ import Simplex.Chat.Markdown (MarkdownList)
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Protocol
+import Simplex.Chat.Remote.AppVersion
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store (AutoAccept, StoreError (..), UserContactLink, UserMsgReceiptSettings)
 import Simplex.Chat.Types
@@ -73,10 +74,12 @@ import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util (allFinally, catchAllErrors, liftEitherError, tryAllErrors, (<$$>))
 import Simplex.Messaging.Version
-import Simplex.RemoteControl.Types
 import System.IO (Handle)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
+import Data.Bifunctor (first)
+import Simplex.RemoteControl.Client
+import Simplex.RemoteControl.Types
 
 versionNumber :: String
 versionNumber = showVersion SC.version
@@ -180,7 +183,7 @@ data ChatController = ChatController
     currentCalls :: TMap ContactId Call,
     localDeviceName :: TVar Text,
     multicastSubscribers :: TMVar Int,
-    remoteHostSessions :: TMap RemoteHostId RemoteHostSession, -- All the active remote hosts
+    remoteHostSessions :: TMap RHKey RemoteHostSession, -- All the active remote hosts
     remoteHostsFolder :: TVar (Maybe FilePath), -- folder for remote hosts data
     remoteCtrlSession :: TVar (Maybe RemoteCtrlSession), -- Supervisor process for hosted controllers
     config :: ChatConfig,
@@ -419,18 +422,18 @@ data ChatCommand
   | SetContactTimedMessages ContactName (Maybe TimedMessagesEnabled)
   | SetGroupTimedMessages GroupName (Maybe Int)
   | SetLocalDeviceName Text
-  | CreateRemoteHost -- ^ Configure a new remote host
+  -- | CreateRemoteHost -- ^ Configure a new remote host
   | ListRemoteHosts
-  | StartRemoteHost RemoteHostId -- ^ Start and announce a remote host
+  | StartRemoteHost (Maybe (RemoteHostId, Bool)) -- ^ Start new or known remote host with optional multicast for known host
   -- | SwitchRemoteHost (Maybe RemoteHostId) -- ^ Switch current remote host
-  | StopRemoteHost RemoteHostId -- ^ Shut down a running session
+  | StopRemoteHost RHKey -- ^ Shut down a running session
   | DeleteRemoteHost RemoteHostId -- ^ Unregister remote host and remove its data
   | StoreRemoteFile {remoteHostId :: RemoteHostId, storeEncrypted :: Maybe Bool, localPath :: FilePath}
   | GetRemoteFile {remoteHostId :: RemoteHostId, file :: RemoteFile}
-  | ConnectRemoteCtrl SignedOOB -- ^ Connect new or existing controller via OOB data
+  | ConnectRemoteCtrl RCSignedInvitation -- ^ Connect new or existing controller via OOB data
   | FindKnownRemoteCtrl -- ^ Start listening for announcements from all existing controllers
   | ConfirmRemoteCtrl RemoteCtrlId -- ^ Confirm the connection with found controller
-  | VerifyRemoteCtrlSession RemoteCtrlId Text -- ^ Verify remote controller session
+  | VerifyRemoteCtrlSession Text -- ^ Verify remote controller session
   | ListRemoteCtrls
   | StopRemoteCtrl -- ^ Stop listening for announcements or terminate an active session
   | DeleteRemoteCtrl RemoteCtrlId -- ^ Remove all local data associated with a remote controller session
@@ -451,7 +454,6 @@ allowRemoteCommand = \case
   APISuspendChat _ -> False
   SetTempFolder _ -> False
   QuitChat -> False
-  CreateRemoteHost -> False
   ListRemoteHosts -> False
   StartRemoteHost _ -> False
   -- SwitchRemoteHost {} -> False
@@ -642,8 +644,8 @@ data ChatResponse
   | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
   | CRRemoteHostCreated {remoteHost :: RemoteHostInfo}
   | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
-  | CRRemoteHostStarted {remoteHost :: RemoteHostInfo, sessionOOB :: Text}
-  | CRRemoteHostSessionCode {remoteHost :: RemoteHostInfo, sessionCode :: Text}
+  | CRRemoteHostStarted {remoteHost_ :: Maybe RemoteHostInfo, invitation :: Text}
+  | CRRemoteHostSessionCode {remoteHost_ :: Maybe RemoteHostInfo, sessionCode :: Text}
   | CRRemoteHostConnected {remoteHost :: RemoteHostInfo}
   | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
   | CRRemoteFileStored {remoteHostId :: RemoteHostId, remoteFileSource :: CryptoFile}
@@ -652,7 +654,7 @@ data ChatResponse
   | 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
-  | CRRemoteCtrlSessionCode {remoteCtrl :: RemoteCtrlInfo, sessionCode :: Text, newCtrl :: Bool}
+  | CRRemoteCtrlSessionCode {remoteCtrl_ :: Maybe RemoteCtrlInfo, sessionCode :: Text}
   | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo}
   | CRRemoteCtrlStopped
   | CRSQLResult {rows :: [Text]}
@@ -949,7 +951,7 @@ data ChatError
   | ChatErrorStore {storeError :: StoreError}
   | ChatErrorDatabase {databaseError :: DatabaseError}
   | ChatErrorRemoteCtrl {remoteCtrlError :: RemoteCtrlError}
-  | ChatErrorRemoteHost {remoteHostId :: RemoteHostId, remoteHostError :: RemoteHostError}
+  | ChatErrorRemoteHost {rhKey :: RHKey, remoteHostError :: RemoteHostError}
   deriving (Show, Exception)
 
 data ChatErrorType
@@ -1048,29 +1050,24 @@ throwDBError = throwError . ChatErrorDatabase
 
 -- TODO review errors, some of it can be covered by HTTP2 errors
 data RemoteHostError
-  = RHMissing -- ^ No remote session matches this identifier
-  | RHBusy -- ^ A session is already running
-  | RHRejected -- ^ A session attempt was rejected by a host
-  | RHTimeout -- ^ A discovery or a remote operation has timed out
-  | RHDisconnected {reason :: Text} -- ^ A session disconnected by a host
-  | RHConnectionLost {reason :: Text} -- ^ A session disconnected due to transport issues
-  | RHProtocolError RemoteProtocolError
+  = RHEMissing -- ^ No remote session matches this identifier
+  | RHEBusy -- ^ A session is already running
+  | RHEBadState -- ^ Illegal state transition
+  | RHEBadVersion {appVersion :: AppVersion}
+  | RHEDisconnected {reason :: Text} -- TODO should be sent when disconnected?
+  | RHEProtocolError RemoteProtocolError
   deriving (Show, Exception)
 
 -- TODO review errors, some of it can be covered by HTTP2 errors
 data RemoteCtrlError
   = RCEInactive -- ^ No session is running
+  | RCEBadState -- ^ A session is in a wrong state for the current operation
   | RCEBusy -- ^ A session is already running
-  | RCETimeout -- ^ Remote operation timed out
   | RCEDisconnected {remoteCtrlId :: RemoteCtrlId, reason :: Text} -- ^ A session disconnected by a controller
-  | RCEConnectionLost {remoteCtrlId :: RemoteCtrlId, reason :: Text} -- ^ A session disconnected due to transport issues
-  | RCECertificateExpired {remoteCtrlId :: RemoteCtrlId} -- ^ A connection or CA certificate in a chain have bad validity period
-  | RCECertificateUntrusted {remoteCtrlId :: RemoteCtrlId} -- ^ TLS is unable to validate certificate chain presented for a connection
-  | RCEBadFingerprint -- ^ Bad fingerprint data provided in OOB
+  | RCEBadInvitation
+  | RCEBadVersion {appVersion :: AppVersion}
   | RCEBadVerificationCode -- ^ The code submitted doesn't match session TLSunique
-  | RCEHTTP2Error {http2Error :: String}
-  | RCEHTTP2RespStatus {statusCode :: Maybe Int} -- TODO remove
-  | RCEInvalidResponse {responseError :: String}
+  | RCEHTTP2Error {http2Error :: Text} -- TODO currently not used
   | RCEProtocolError {protocolError :: RemoteProtocolError}
   deriving (Show, Exception)
 
@@ -1080,15 +1077,26 @@ data ArchiveError
   deriving (Show, Exception)
 
 -- | Host (mobile) side of transport to process remote commands and forward notifications
-data RemoteCtrlSession = RemoteCtrlSession
-  { discoverer :: Async (), -- multicast listener
-    supervisor :: Async (), -- session state/subprocess supervisor
-    hostServer :: Maybe (Async ()), -- a running session
-    discovered :: TMap C.KeyHash (TransportHost, Word16), -- multicast-announced services
-    confirmed :: TMVar RemoteCtrlId, -- connection fingerprint found/stored in DB
-    verified :: TMVar (RemoteCtrlId, Text), -- user confirmed the session
-    remoteOutputQ :: TBQueue ChatResponse
-  }
+data RemoteCtrlSession
+  = RCSessionStarting
+  | RCSessionConnecting
+      { rcsClient :: RCCtrlClient,
+        rcsWaitSession :: Async ()
+      }
+  | RCSessionPendingConfirmation
+      { ctrlName :: Text,
+        rcsClient :: RCCtrlClient,
+        sessionCode :: Text,
+        rcsWaitSession :: Async (),
+        rcsWaitConfirmation :: TMVar (Either RCErrorType (RCCtrlSession, RCCtrlPairing))
+      }
+  | RCSessionConnected
+      { remoteCtrlId :: RemoteCtrlId,
+        rcsClient :: RCCtrlClient,
+        rcsSession :: RCCtrlSession,
+        http2Server :: Async (),
+        remoteOutputQ :: TBQueue ChatResponse
+      }
 
 type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m)
 
@@ -1140,17 +1148,13 @@ throwChatError = throwError . ChatError
 toView :: ChatMonad' m => ChatResponse -> m ()
 toView event = do
   localQ <- asks outputQ
-  chatReadVar remoteCtrlSession >>= \case
-    Nothing -> atomically $ writeTBQueue localQ (Nothing, Nothing, event)
-    Just RemoteCtrlSession {remoteOutputQ} ->
-      if allowRemoteEvent event
-        then do
-          -- TODO: filter events or let the UI ignore trigger events by itself?
-          -- traceM $ "Sending event to remote Q: " <> show event
-          atomically $ writeTBQueue remoteOutputQ event -- TODO: check full?
-        else do
-          -- traceM $ "Sending event to local Q: " <> show event
-          atomically $ writeTBQueue localQ (Nothing, Nothing, event)
+  session <- asks remoteCtrlSession
+  atomically $
+    readTVar session >>= \case
+      Just RCSessionConnected {remoteOutputQ} | allowRemoteEvent event ->
+        writeTBQueue remoteOutputQ event
+      -- TODO potentially, it should hold some events while connecting
+      _ -> writeTBQueue localQ (Nothing, Nothing, event)
 
 withStore' :: ChatMonad m => (DB.Connection -> IO a) -> m a
 withStore' action = withStore $ liftIO . action
@@ -1179,6 +1183,12 @@ withStoreCtx ctx_ action = do
     handleInternal :: String -> SomeException -> IO (Either StoreError a)
     handleInternal ctxStr e = pure . Left . SEInternalError $ show e <> ctxStr
 
+withAgent :: ChatMonad m => (AgentClient -> ExceptT AgentErrorType m a) -> m a
+withAgent action =
+  asks smpAgent
+    >>= runExceptT . action
+    >>= liftEither . first (`ChatErrorAgent` Nothing)
+
 $(JQ.deriveJSON (enumJSON $ dropPrefix "HS") ''HelpSection)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "ILP") ''InvitationLinkPlan)
diff --git a/src/Simplex/Chat/Migrations/M20231114_remote_controller.hs b/src/Simplex/Chat/Migrations/M20231114_remote_controller.hs
index 5b7ea1c7b..a8e92a998 100644
--- a/src/Simplex/Chat/Migrations/M20231114_remote_controller.hs
+++ b/src/Simplex/Chat/Migrations/M20231114_remote_controller.hs
@@ -10,18 +10,32 @@ m20231114_remote_controller =
   [sql|
 CREATE TABLE remote_hosts ( -- hosts known to a controlling app
   remote_host_id INTEGER PRIMARY KEY AUTOINCREMENT,
-  store_path TEXT NOT NULL,            -- file path relative to app store (must not contain "/")
-  display_name TEXT NOT NULL,          -- user-provided name for a remote host
-  ca_key BLOB NOT NULL,                -- private key for signing session certificates
-  ca_cert BLOB NOT NULL,               -- root certificate, whose fingerprint is pinned on a remote
-  contacted INTEGER NOT NULL DEFAULT 0 -- 0 (first time), 1 (connected before)
+  host_device_name TEXT NOT NULL,
+  store_path TEXT NOT NULL, -- file path for host files relative to app storage (must not contain "/")
+  -- RCHostPairing
+  ca_key BLOB NOT NULL, -- private key to sign session certificates
+  ca_cert BLOB NOT NULL, -- root certificate
+  id_key BLOB NOT NULL, -- long-term/identity signing key
+  -- KnownHostPairing
+  host_fingerprint BLOB NOT NULL, -- pinned remote host CA, set when connected
+  -- stored host session key
+  host_dh_pub BLOB NOT NULL, -- session DH key
+  UNIQUE (host_fingerprint) ON CONFLICT FAIL
 );
 
 CREATE TABLE remote_controllers ( -- controllers known to a hosting app
-  remote_controller_id INTEGER PRIMARY KEY AUTOINCREMENT,
-  display_name TEXT NOT NULL, -- user-provided name for a remote controller
-  fingerprint BLOB NOT NULL,  -- remote controller CA fingerprint
-  accepted INTEGER            -- NULL (unknown), 0 (rejected), 1 (confirmed)
+  remote_ctrl_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  ctrl_device_name TEXT NOT NULL,
+  -- RCCtrlPairing
+  ca_key BLOB NOT NULL, -- CA key
+  ca_cert BLOB NOT NULL, -- CA certificate for TLS clients
+  ctrl_fingerprint BLOB NOT NULL, -- remote controller CA, set when connected
+  id_pub BLOB NOT NULL, -- remote controller long-term/identity key to verify signatures
+  -- stored session key, commited on connection confirmation
+  dh_priv_key BLOB NOT NULL, -- session DH key
+  -- prev session key
+  prev_dh_priv_key BLOB, -- previous session DH key
+  UNIQUE (ctrl_fingerprint) ON CONFLICT FAIL
 );
 |]
 
diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql
index ebe3fc111..bef0d3605 100644
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -523,18 +523,32 @@ CREATE TABLE IF NOT EXISTS "received_probes"(
 CREATE TABLE remote_hosts(
   -- hosts known to a controlling app
   remote_host_id INTEGER PRIMARY KEY AUTOINCREMENT,
-  store_path TEXT NOT NULL, -- file path relative to app store(must not contain "/")
-  display_name TEXT NOT NULL, -- user-provided name for a remote host
-  ca_key BLOB NOT NULL, -- private key for signing session certificates
-  ca_cert BLOB NOT NULL, -- root certificate, whose fingerprint is pinned on a remote
-  contacted INTEGER NOT NULL DEFAULT 0 -- 0(first time), 1(connected before)
+  host_device_name TEXT NOT NULL,
+  store_path TEXT NOT NULL, -- file path for host files relative to app storage(must not contain "/")
+  -- RCHostPairing
+  ca_key BLOB NOT NULL, -- private key to sign session certificates
+  ca_cert BLOB NOT NULL, -- root certificate
+  id_key BLOB NOT NULL, -- long-term/identity signing key
+  -- KnownHostPairing
+  host_fingerprint BLOB NOT NULL, -- pinned remote host CA, set when connected
+  -- stored host session key
+  host_dh_pub BLOB NOT NULL, -- session DH key
+  UNIQUE(host_fingerprint) ON CONFLICT FAIL
 );
 CREATE TABLE remote_controllers(
   -- controllers known to a hosting app
-  remote_controller_id INTEGER PRIMARY KEY AUTOINCREMENT,
-  display_name TEXT NOT NULL, -- user-provided name for a remote controller
-  fingerprint BLOB NOT NULL, -- remote controller CA fingerprint
-  accepted INTEGER -- NULL(unknown), 0(rejected), 1(confirmed)
+  remote_ctrl_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  ctrl_device_name TEXT NOT NULL,
+  -- RCCtrlPairing
+  ca_key BLOB NOT NULL, -- CA key
+  ca_cert BLOB NOT NULL, -- CA certificate for TLS clients
+  ctrl_fingerprint BLOB NOT NULL, -- remote controller CA, set when connected
+  id_pub BLOB NOT NULL, -- remote controller long-term/identity key to verify signatures
+  -- stored session key, commited on connection confirmation
+  dh_priv_key BLOB NOT NULL, -- session DH key
+  -- prev session key
+  prev_dh_priv_key BLOB, -- previous session DH key
+  UNIQUE(ctrl_fingerprint) ON CONFLICT FAIL
 );
 CREATE INDEX contact_profiles_index ON contact_profiles(
   display_name,
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index cb943ac2c..8bb354c21 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -1,13 +1,14 @@
-{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Chat.Remote where
@@ -18,161 +19,202 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Control.Monad.Reader
-import Control.Monad.STM (retry)
 import Crypto.Random (getRandomBytes)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.Types as JT
+import Data.Bifunctor (second)
 import Data.ByteString (ByteString)
 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.Maybe (fromMaybe, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Data.Text.Encoding (encodeUtf8)
 import Data.Word (Word16, Word32)
 import qualified Network.HTTP.Types as N
+import Network.HTTP2.Client (HTTP2Error (..))
 import Network.HTTP2.Server (responseStreaming)
-import Network.Socket (SockAddr (..), hostAddressToTuple)
+import qualified Paths_simplex_chat as SC
 import Simplex.Chat.Archive (archiveFilesFolder)
 import Simplex.Chat.Controller
 import Simplex.Chat.Files
 import Simplex.Chat.Messages (chatNameStr)
+import Simplex.Chat.Remote.AppVersion
 import Simplex.Chat.Remote.Protocol
-import Simplex.Chat.Remote.RevHTTP (announceRevHTTP2, attachHTTP2Server)
+import Simplex.Chat.Remote.RevHTTP (attachHTTP2Server, attachRevHTTP2Client)
 import Simplex.Chat.Remote.Transport
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Remote
 import Simplex.Chat.Store.Shared
-import Simplex.Chat.Types (User (..))
+import Simplex.Chat.Types
 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 (smpDecode)
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (tlsUniq)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
-import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2ClientError, closeHTTP2Client)
 import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
-import Simplex.Messaging.Util (ifM, liftEitherError, liftEitherWith, liftError, liftIOEither, tryAllErrors, tshow, ($>>=), (<$$>))
-import qualified Simplex.RemoteControl.Discovery as Discovery
+import Simplex.Messaging.Util
+import Simplex.RemoteControl.Client
+import Simplex.RemoteControl.Invitation (RCInvitation (..), RCSignedInvitation (..))
 import Simplex.RemoteControl.Types
 import System.FilePath (takeFileName, (</>))
 import UnliftIO
-import UnliftIO.Concurrent (threadDelay)
+import UnliftIO.Concurrent (forkIO)
 import UnliftIO.Directory (copyFile, createDirectoryIfMissing, renameFile)
 
+-- when acting as host
+minRemoteCtrlVersion :: AppVersion
+minRemoteCtrlVersion = AppVersion [5, 4, 0, 2]
+
+-- when acting as controller
+minRemoteHostVersion :: AppVersion
+minRemoteHostVersion = AppVersion [5, 4, 0, 2]
+
+currentAppVersion :: AppVersion
+currentAppVersion = AppVersion SC.version
+
+ctrlAppVersionRange :: AppVersionRange
+ctrlAppVersionRange = mkAppVersionRange minRemoteHostVersion currentAppVersion
+
+hostAppVersionRange :: AppVersionRange
+hostAppVersionRange = mkAppVersionRange minRemoteCtrlVersion currentAppVersion
+
 -- * Desktop side
 
-getRemoteHostSession :: ChatMonad m => RemoteHostId -> m RemoteHostSession
-getRemoteHostSession rhId = withRemoteHostSession rhId $ \_ s -> pure $ Right s
-
-withRemoteHostSession :: ChatMonad m => RemoteHostId -> (TM.TMap RemoteHostId RemoteHostSession -> RemoteHostSession -> STM (Either ChatError a)) -> m a
-withRemoteHostSession rhId = withRemoteHostSession_ rhId missing
+getRemoteHostClient :: ChatMonad m => RemoteHostId -> m RemoteHostClient
+getRemoteHostClient rhId = withRemoteHostSession rhKey $ \case
+  s@RHSessionConnected {rhClient} -> Right (rhClient, s)
+  _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
   where
-    missing _ = pure . Left $ ChatErrorRemoteHost rhId RHMissing
+    rhKey = RHId rhId
 
-withNoRemoteHostSession :: ChatMonad m => RemoteHostId -> (TM.TMap RemoteHostId RemoteHostSession -> STM (Either ChatError a)) -> m a
-withNoRemoteHostSession rhId action = withRemoteHostSession_ rhId action busy
-  where
-    busy _ _ = pure . Left $ ChatErrorRemoteHost rhId RHBusy
+withRemoteHostSession :: ChatMonad m => RHKey -> (RemoteHostSession -> Either ChatError (a, RemoteHostSession)) -> m a
+withRemoteHostSession rhKey state = withRemoteHostSession_ rhKey $ maybe (Left $ ChatErrorRemoteHost rhKey $ RHEMissing) ((second . second) Just . state)
 
--- | Atomically process controller state wrt. specific remote host session
-withRemoteHostSession_ :: ChatMonad m => RemoteHostId -> (TM.TMap RemoteHostId RemoteHostSession -> STM (Either ChatError a)) -> (TM.TMap RemoteHostId RemoteHostSession -> RemoteHostSession -> STM (Either ChatError a)) -> m a
-withRemoteHostSession_ rhId missing present = do
+withRemoteHostSession_ :: ChatMonad m => RHKey -> (Maybe RemoteHostSession -> Either ChatError (a, Maybe RemoteHostSession)) -> m a
+withRemoteHostSession_ rhKey state = do
   sessions <- asks remoteHostSessions
-  liftIOEither . atomically $ TM.lookup rhId sessions >>= maybe (missing sessions) (present sessions)
+  r <- atomically $ do
+    s <- TM.lookup rhKey sessions
+    case state s of
+      Left e -> pure $ Left e
+      Right (a, s') -> Right a <$ maybe (TM.delete rhKey) (TM.insert rhKey) s' sessions
+  liftEither r
 
-startRemoteHost :: ChatMonad m => RemoteHostId -> m ()
-startRemoteHost rhId = do
-  rh <- withStore (`getRemoteHost` rhId)
-  tasks <- startRemoteHostSession rh
-  logInfo $ "Remote host session starting for " <> tshow rhId
-  asyncRegistered tasks $
-    run rh tasks `catchAny` \err -> do
-      logError $ "Remote host session startup failed for " <> tshow rhId <> ": " <> tshow err
-      cancelTasks tasks
-      chatModifyVar remoteHostSessions $ M.delete rhId
-      throwError $ fromMaybe (mkChatError err) $ fromException err
+setNewRemoteHostId :: ChatMonad m => RHKey -> RemoteHostId -> m ()
+setNewRemoteHostId rhKey rhId = do
+  sessions <- asks remoteHostSessions
+  r <- atomically $ do
+    TM.lookupDelete rhKey sessions >>= \case
+      Nothing -> pure $ Left $ ChatErrorRemoteHost rhKey RHEMissing
+      Just s -> Right () <$ TM.insert (RHId rhId) s sessions
+  liftEither r
+
+startRemoteHost' :: ChatMonad m => Maybe (RemoteHostId, Bool) -> m (Maybe RemoteHostInfo, RCSignedInvitation)
+startRemoteHost' rh_ = do
+  (rhKey, multicast, remoteHost_, pairing) <- case rh_ of
+    Just (rhId, multicast) -> do
+      rh@RemoteHost {hostPairing} <- withStore $ \db -> getRemoteHost db rhId
+      pure (RHId rhId, multicast, Just $ remoteHostInfo rh True, hostPairing) -- get from the database, start multicast if requested
+    Nothing -> (RHNew,False,Nothing,) <$> rcNewHostPairing
+  withRemoteHostSession_ rhKey $ maybe (Right ((), Just RHSessionStarting)) (\_ -> Left $ ChatErrorRemoteHost rhKey RHEBusy)
+  ctrlAppInfo <- mkCtrlAppInfo
+  (invitation, rchClient, vars) <- withAgent $ \a -> rcConnectHost a pairing (J.toJSON ctrlAppInfo) multicast
+  rhsWaitSession <- async $ waitForSession rhKey remoteHost_ rchClient vars
+  let rhs = RHPendingSession {rhKey, rchClient, rhsWaitSession, remoteHost_}
+  withRemoteHostSession rhKey $ \case
+    RHSessionStarting -> Right ((), RHSessionConnecting rhs)
+    _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
+  pure (remoteHost_, invitation)
   where
-    -- logInfo $ "Remote host session starting for " <> tshow rhId
-
-    run :: ChatMonad m => RemoteHost -> Tasks -> m ()
-    run rh@RemoteHost {storePath} tasks = do
-      (fingerprint, credentials) <- liftIO $ genSessionCredentials rh
-      cleanupIO <- toIO $ do
-        logNote $ "Remote host session stopping for " <> tshow rhId
-        cancelTasks tasks -- cancel our tasks anyway
-        chatModifyVar currentRemoteHost $ \cur -> if cur == Just rhId then Nothing else cur -- only wipe the closing RH
-        withRemoteHostSession rhId $ \sessions _ -> Right <$> TM.delete rhId sessions
-        toView (CRRemoteHostStopped rhId) -- only signal "stopped" when the session is unregistered cleanly
-        -- block until some client is connected or an error happens
-      logInfo $ "Remote host session connecting for " <> tshow rhId
-      rcName <- chatReadVar localDeviceName
-      localAddr <- asks multicastSubscribers >>= Discovery.getLocalAddress >>= maybe (throwError . ChatError $ CEInternalError "unable to get local address") pure
-      (dhKey, sigKey, ann, oob) <- Discovery.startSession (if rcName == "" then Nothing else Just rcName) (localAddr, read Discovery.DISCOVERY_PORT) fingerprint
-      toView CRRemoteHostStarted {remoteHost = remoteHostInfo rh True, sessionOOB = decodeUtf8 $ strEncode oob}
-      httpClient <- liftEitherError (ChatErrorRemoteCtrl . RCEHTTP2Error . show) $ announceRevHTTP2 tasks (sigKey, ann) credentials cleanupIO
-      logInfo $ "Remote host session connected for " <> tshow rhId
-      -- test connection and establish a protocol layer
-      remoteHostClient <- liftRH rhId $ createRemoteHostClient httpClient dhKey rcName
-      -- set up message polling
+    mkCtrlAppInfo = do
+      deviceName <- chatReadVar localDeviceName
+      pure CtrlAppInfo {appVersionRange = ctrlAppVersionRange, deviceName}
+    parseHostAppInfo RCHostHello {app = hostAppInfo} rhKey = do
+      HostAppInfo {deviceName, appVersion} <-
+        liftEitherWith (ChatErrorRemoteHost rhKey . RHEProtocolError . RPEInvalidJSON) $ JT.parseEither J.parseJSON hostAppInfo
+      unless (isAppCompatible appVersion ctrlAppVersionRange) $ throwError $ ChatErrorRemoteHost rhKey $ RHEBadVersion appVersion
+      pure deviceName
+    waitForSession :: ChatMonad m => RHKey -> Maybe RemoteHostInfo -> RCHostClient -> RCStepTMVar (ByteString, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
+    waitForSession rhKey remoteHost_ _rchClient_kill_on_error vars = do
+      -- TODO handle errors
+      (sessId, vars') <- takeRCStep vars
+      toView $ CRRemoteHostSessionCode {remoteHost_, sessionCode = verificationCode sessId} -- display confirmation code, wait for mobile to confirm
+      (RCHostSession {tls, sessionKeys}, rhHello, pairing') <- takeRCStep vars'
+      hostDeviceName <- parseHostAppInfo rhHello rhKey
+      withRemoteHostSession rhKey $ \case
+        RHSessionConnecting rhs' -> Right ((), RHSessionConfirmed rhs') -- TODO check it's the same session?
+        _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState -- TODO kill client on error
+      -- update remoteHost with updated pairing
+      rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' remoteHost_ hostDeviceName
+      let rhKey' = RHId remoteHostId
+      disconnected <- toIO $ onDisconnected remoteHostId
+      httpClient <- liftEitherError (httpError rhKey) $ attachRevHTTP2Client disconnected tls
+      rhClient <- liftRC $ createRemoteHostClient httpClient sessionKeys storePath hostDeviceName
+      pollAction <- async $ pollEvents remoteHostId rhClient
+      withRemoteHostSession rhKey' $ \case
+        RHSessionConfirmed RHPendingSession {} -> Right ((), RHSessionConnected {rhClient, pollAction, storePath})
+        _ -> Left $ ChatErrorRemoteHost rhKey' RHEBadState -- TODO kill client on error
+      chatWriteVar currentRemoteHost $ Just remoteHostId -- this is required for commands to be passed to remote host
+      toView $ CRRemoteHostConnected rhi
+    upsertRemoteHost :: ChatMonad m => RCHostPairing -> Maybe RemoteHostInfo -> Text -> m RemoteHostInfo
+    upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rh_ hostDeviceName = do
+      KnownHostPairing {hostDhPubKey = hostDhPubKey'} <- maybe (throwError . ChatError $ CEInternalError "KnownHost is known after verification") pure kh_
+      case rh_ of
+        Nothing -> do
+          storePath <- liftIO randomStorePath
+          rh@RemoteHost {remoteHostId} <- withStore $ \db -> insertRemoteHost db hostDeviceName storePath pairing' >>= getRemoteHost db
+          setNewRemoteHostId RHNew remoteHostId
+          pure $ remoteHostInfo rh True
+        Just rhi@RemoteHostInfo {remoteHostId} -> do
+          withStore' $ \db -> updateHostPairing db remoteHostId hostDeviceName hostDhPubKey'
+          pure rhi
+    onDisconnected :: ChatMonad m => RemoteHostId -> m ()
+    onDisconnected remoteHostId = do
+      logDebug "HTTP2 client disconnected"
+      chatModifyVar currentRemoteHost $ \cur -> if cur == Just remoteHostId then Nothing else cur -- only wipe the closing RH
+      sessions <- asks remoteHostSessions
+      void . atomically $ TM.lookupDelete (RHId remoteHostId) sessions
+      toView $ CRRemoteHostStopped remoteHostId
+    pollEvents :: ChatMonad m => RemoteHostId -> RemoteHostClient -> m ()
+    pollEvents rhId rhClient = do
       oq <- asks outputQ
-      asyncRegistered tasks . forever $ do
-        liftRH rhId (remoteRecv remoteHostClient 1000000) >>= mapM_ (atomically . writeTBQueue oq . (Nothing,Just rhId,))
-      -- update session state
-      logInfo $ "Remote host session started for " <> tshow rhId
-      chatModifyVar remoteHostSessions $ M.adjust (\rhs -> rhs {remoteHostClient = Just remoteHostClient}) rhId
-      chatWriteVar currentRemoteHost $ Just rhId
-      toView $
-        CRRemoteHostConnected
-          RemoteHostInfo
-            { remoteHostId = rhId,
-              storePath = storePath,
-              displayName = hostDeviceName remoteHostClient,
-              sessionActive = True
-            }
+      forever $ do
+        r_ <- liftRH rhId $ remoteRecv rhClient 10000000
+        forM r_ $ \r -> atomically $ writeTBQueue oq (Nothing, Just rhId, r)
+    httpError :: RHKey -> HTTP2ClientError -> ChatError
+    httpError rhKey = ChatErrorRemoteHost rhKey . RHEProtocolError . RPEHTTP2 . tshow
 
-    genSessionCredentials RemoteHost {caKey, caCert} = do
-      sessionCreds <- genCredentials (Just parent) (0, 24) "Session"
-      pure . tlsCredentials $ sessionCreds :| [parent]
-      where
-        parent = (C.signatureKeyPair caKey, caCert)
+closeRemoteHost :: ChatMonad m => RHKey -> m ()
+closeRemoteHost rhKey = do
+  logNote $ "Closing remote host session for " <> tshow rhKey
+  chatModifyVar currentRemoteHost $ \cur -> if (RHId <$> cur) == Just rhKey then Nothing else cur -- only wipe the closing RH
+  join . withRemoteHostSession_ rhKey . maybe (Left $ ChatErrorRemoteCtrl RCEInactive) $
+    \s -> Right (liftIO $ cancelRemoteHost s, Nothing)
 
--- | Atomically check/register session and prepare its task list
-startRemoteHostSession :: ChatMonad m => RemoteHost -> m Tasks
-startRemoteHostSession RemoteHost {remoteHostId, storePath} = withNoRemoteHostSession remoteHostId $ \sessions -> do
-  remoteHostTasks <- newTVar []
-  TM.insert remoteHostId RemoteHostSession {remoteHostTasks, storePath, remoteHostClient = Nothing} sessions
-  pure $ Right remoteHostTasks
-
-closeRemoteHostSession :: ChatMonad m => RemoteHostId -> m ()
-closeRemoteHostSession rhId = do
-  logNote $ "Closing remote host session for " <> tshow rhId
-  chatModifyVar currentRemoteHost $ \cur -> if cur == Just rhId then Nothing else cur -- only wipe the closing RH
-  session <- withRemoteHostSession rhId $ \sessions rhs -> Right rhs <$ TM.delete rhId sessions
-  cancelRemoteHostSession session
-
-cancelRemoteHostSession :: MonadUnliftIO m => RemoteHostSession -> m ()
-cancelRemoteHostSession RemoteHostSession {remoteHostTasks, remoteHostClient} = do
-  cancelTasks remoteHostTasks
-  mapM_ closeRemoteHostClient remoteHostClient
-
-createRemoteHost :: ChatMonad m => m RemoteHostInfo
-createRemoteHost = do
-  ((_, caKey), caCert) <- liftIO $ genCredentials Nothing (-25, 24 * 365) "Host"
-  storePath <- liftIO randomStorePath
-  let remoteName = "" -- will be passed from remote host in hello
-  rhId <- withStore' $ \db -> insertRemoteHost db storePath remoteName caKey caCert
-  rh <- withStore $ \db -> getRemoteHost db rhId
-  pure $ remoteHostInfo rh False
+cancelRemoteHost :: RemoteHostSession -> IO ()
+cancelRemoteHost = \case
+  RHSessionStarting -> pure ()
+  RHSessionConnecting rhs -> cancelPendingSession rhs
+  RHSessionConfirmed rhs -> cancelPendingSession rhs
+  RHSessionConnected {rhClient = RemoteHostClient {httpClient}, pollAction} -> do
+    uninterruptibleCancel pollAction
+    closeHTTP2Client httpClient
+  where
+    cancelPendingSession RHPendingSession {rchClient, rhsWaitSession} = do
+      cancelHostClient rchClient
+      uninterruptibleCancel rhsWaitSession
 
 -- | Generate a random 16-char filepath without / in it by using base64url encoding.
 randomStorePath :: IO FilePath
@@ -184,11 +226,12 @@ listRemoteHosts = do
   map (rhInfo active) <$> withStore' getRemoteHosts
   where
     rhInfo active rh@RemoteHost {remoteHostId} =
-      remoteHostInfo rh (M.member remoteHostId active)
+      remoteHostInfo rh (M.member (RHId remoteHostId) active)
 
+-- XXX: replacing hostPairing replaced with sessionActive, could be a ($>)
 remoteHostInfo :: RemoteHost -> Bool -> RemoteHostInfo
-remoteHostInfo RemoteHost {remoteHostId, storePath, displayName} sessionActive =
-  RemoteHostInfo {remoteHostId, storePath, displayName, sessionActive}
+remoteHostInfo RemoteHost {remoteHostId, storePath, hostName} sessionActive =
+  RemoteHostInfo {remoteHostId, storePath, hostName, sessionActive}
 
 deleteRemoteHost :: ChatMonad m => RemoteHostId -> m ()
 deleteRemoteHost rhId = do
@@ -202,20 +245,17 @@ deleteRemoteHost rhId = do
 
 storeRemoteFile :: forall m. ChatMonad m => RemoteHostId -> Maybe Bool -> FilePath -> m CryptoFile
 storeRemoteFile rhId encrypted_ localPath = do
-  RemoteHostSession {remoteHostClient, storePath} <- getRemoteHostSession rhId
-  case remoteHostClient of
-    Nothing -> throwError $ ChatErrorRemoteHost rhId RHMissing
-    Just c@RemoteHostClient {encryptHostFiles} -> do
-      let encrypt = fromMaybe encryptHostFiles encrypted_
-      cf@CryptoFile {filePath} <- if encrypt then encryptLocalFile else pure $ CF.plain localPath
-      filePath' <- liftRH rhId $ remoteStoreFile c filePath (takeFileName localPath)
-      hf_ <- chatReadVar remoteHostsFolder
-      forM_ hf_ $ \hf -> do
-        let rhf = hf </> storePath </> archiveFilesFolder
-            hPath = rhf </> takeFileName filePath'
-        createDirectoryIfMissing True rhf
-        (if encrypt then renameFile else copyFile) filePath hPath
-      pure (cf :: CryptoFile) {filePath = filePath'}
+  c@RemoteHostClient {encryptHostFiles, storePath} <- getRemoteHostClient rhId
+  let encrypt = fromMaybe encryptHostFiles encrypted_
+  cf@CryptoFile {filePath} <- if encrypt then encryptLocalFile else pure $ CF.plain localPath
+  filePath' <- liftRH rhId $ remoteStoreFile c filePath (takeFileName localPath)
+  hf_ <- chatReadVar remoteHostsFolder
+  forM_ hf_ $ \hf -> do
+    let rhf = hf </> storePath </> archiveFilesFolder
+        hPath = rhf </> takeFileName filePath'
+    createDirectoryIfMissing True rhf
+    (if encrypt then renameFile else copyFile) filePath hPath
+  pure (cf :: CryptoFile) {filePath = filePath'}
   where
     encryptLocalFile :: m CryptoFile
     encryptLocalFile = do
@@ -228,78 +268,69 @@ storeRemoteFile rhId encrypted_ localPath = do
 
 getRemoteFile :: ChatMonad m => RemoteHostId -> RemoteFile -> m ()
 getRemoteFile rhId rf = do
-  RemoteHostSession {remoteHostClient, storePath} <- getRemoteHostSession rhId
-  case remoteHostClient of
-    Nothing -> throwError $ ChatErrorRemoteHost rhId RHMissing
-    Just c -> do
-      dir <- (</> storePath </> archiveFilesFolder) <$> (maybe getDefaultFilesFolder pure =<< chatReadVar remoteHostsFolder)
-      createDirectoryIfMissing True dir
-      liftRH rhId $ remoteGetFile c dir rf
+  c@RemoteHostClient {storePath} <- getRemoteHostClient rhId
+  dir <- (</> storePath </> archiveFilesFolder) <$> (maybe getDefaultFilesFolder pure =<< chatReadVar remoteHostsFolder)
+  createDirectoryIfMissing True dir
+  liftRH rhId $ remoteGetFile c dir rf
 
-processRemoteCommand :: ChatMonad m => RemoteHostId -> RemoteHostSession -> ChatCommand -> ByteString -> m ChatResponse
-processRemoteCommand remoteHostId RemoteHostSession {remoteHostClient = Just rhc} cmd s = case cmd of
+processRemoteCommand :: ChatMonad m => RemoteHostId -> RemoteHostClient -> ChatCommand -> ByteString -> m ChatResponse
+processRemoteCommand remoteHostId c cmd s = case cmd of
   SendFile chatName f -> sendFile "/f" chatName f
   SendImage chatName f -> sendFile "/img" chatName f
-  _ -> liftRH remoteHostId $ remoteSend rhc s
+  _ -> liftRH remoteHostId $ remoteSend c s
   where
     sendFile cmdName chatName (CryptoFile path cfArgs) = do
       -- don't encrypt in host if already encrypted locally
       CryptoFile path' cfArgs' <- storeRemoteFile remoteHostId (cfArgs $> False) path
       let f = CryptoFile path' (cfArgs <|> cfArgs') -- use local or host encryption
-      liftRH remoteHostId $ remoteSend rhc $ B.unwords [cmdName, B.pack (chatNameStr chatName), cryptoFileStr f]
+      liftRH remoteHostId $ remoteSend c $ B.unwords [cmdName, B.pack (chatNameStr chatName), cryptoFileStr f]
     cryptoFileStr CryptoFile {filePath, cryptoArgs} =
       maybe "" (\(CFArgs key nonce) -> "key=" <> strEncode key <> " nonce=" <> strEncode nonce <> " ") cryptoArgs
         <> encodeUtf8 (T.pack filePath)
-processRemoteCommand _ _ _ _ = pure $ chatCmdError Nothing "remote command sent before session started"
 
 liftRH :: ChatMonad m => RemoteHostId -> ExceptT RemoteProtocolError IO a -> m a
-liftRH rhId = liftError (ChatErrorRemoteHost rhId . RHProtocolError)
+liftRH rhId = liftError (ChatErrorRemoteHost (RHId rhId) . RHEProtocolError)
 
 -- * Mobile side
 
-findKnownRemoteCtrl :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> m ()
-findKnownRemoteCtrl execChatCommand = do
-  logInfo "Starting remote host"
-  checkNoRemoteCtrlSession -- tiny race with the final @chatWriteVar@ until the setup finishes and supervisor spawned
-  discovered <- newTVarIO mempty
-  discoverer <- async $ discoverRemoteCtrls discovered -- TODO extract to a controller service singleton
-  size <- asks $ tbqSize . config
-  remoteOutputQ <- newTBQueueIO size
-  confirmed <- newEmptyTMVarIO
-  verified <- newEmptyTMVarIO
-  supervisor <- async $ do
-    threadDelay 500000 -- give chat controller a chance to reply with "ok" to prevent flaking tests
-    runHost discovered confirmed verified $ handleRemoteCommand execChatCommand remoteOutputQ
-  chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, confirmed, verified, remoteOutputQ}
+findKnownRemoteCtrl :: ChatMonad m => m ()
+findKnownRemoteCtrl = undefined -- do
 
--- | Track remote host lifecycle in controller session state and signal UI on its progress
-runHost :: ChatMonad m => TM.TMap C.KeyHash (TransportHost, Word16) -> TMVar RemoteCtrlId -> TMVar (RemoteCtrlId, Text) -> (HTTP2Request -> m ()) -> m ()
-runHost discovered confirmed verified handleHttp = do
-  remoteCtrlId <- atomically (readTMVar confirmed) -- wait for discoverRemoteCtrls.process or confirmRemoteCtrl to confirm fingerprint as a known RC
-  rc@RemoteCtrl {fingerprint} <- withStore (`getRemoteCtrl` remoteCtrlId)
-  serviceAddress <- atomically $ TM.lookup fingerprint discovered >>= maybe retry pure -- wait for location of the matching fingerprint
-  toView $ CRRemoteCtrlConnecting $ remoteCtrlInfo rc False
-  atomically $ writeTVar discovered mempty -- flush unused sources
-  server <- async $
-    -- spawn server for remote protocol commands
-    Discovery.connectTLSClient serviceAddress fingerprint $ \tls -> do
-      let sessionCode = decodeUtf8 . strEncode $ tlsUniq tls
-      toView $ CRRemoteCtrlSessionCode {remoteCtrl = remoteCtrlInfo rc True, sessionCode, newCtrl = False}
-      userInfo <- atomically $ readTMVar verified
-      if userInfo == (remoteCtrlId, sessionCode)
-        then do
-          toView $ CRRemoteCtrlConnected $ remoteCtrlInfo rc True
-          attachHTTP2Server handleHttp tls
-        else do
-          toView $ CRChatCmdError Nothing $ ChatErrorRemoteCtrl RCEBadVerificationCode
-          -- the server doesn't enter its loop and waitCatch below falls through
-  chatModifyVar remoteCtrlSession $ fmap $ \s -> s {hostServer = Just server}
-  _ <- waitCatch server -- wait for the server to finish
-  chatWriteVar remoteCtrlSession Nothing
-  toView CRRemoteCtrlStopped
+-- | Use provided OOB link as an annouce
+connectRemoteCtrl :: ChatMonad m => RCSignedInvitation -> m ()
+connectRemoteCtrl inv@RCSignedInvitation {invitation = RCInvitation {ca, app}} = do
+  (ctrlDeviceName, v) <- parseCtrlAppInfo app
+  withRemoteCtrlSession_ $ maybe (Right ((), Just RCSessionStarting)) (\_ -> Left $ ChatErrorRemoteCtrl RCEBusy)
+  rc_ <- withStore' $ \db -> getRemoteCtrlByFingerprint db ca
+  hostAppInfo <- getHostAppInfo v
+  (rcsClient, vars) <- withAgent $ \a -> rcConnectCtrlURI a inv (ctrlPairing <$> rc_) (J.toJSON hostAppInfo)
+  rcsWaitSession <- async $ waitForSession rc_ ctrlDeviceName rcsClient vars
+  updateRemoteCtrlSession $ \case
+    RCSessionStarting -> Right RCSessionConnecting {rcsClient, rcsWaitSession}
+    _ -> Left $ ChatErrorRemoteCtrl RCEBadState -- TODO kill rcsClient
+  where
+    waitForSession :: ChatMonad m => Maybe RemoteCtrl -> Text -> RCCtrlClient -> RCStepTMVar (ByteString, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> m ()
+    waitForSession rc_ ctrlName rcsClient vars = do
+      (uniq, rcsWaitConfirmation) <- takeRCStep vars
+      let sessionCode = verificationCode uniq
+      toView CRRemoteCtrlSessionCode {remoteCtrl_ = (`remoteCtrlInfo` True) <$> rc_, sessionCode}
+      updateRemoteCtrlSession $ \case
+        RCSessionConnecting {rcsWaitSession} -> Right RCSessionPendingConfirmation {ctrlName, rcsClient, sessionCode, rcsWaitSession, rcsWaitConfirmation}
+        _ -> Left $ ChatErrorRemoteCtrl RCEBadState -- TODO kill rcsClient
+    parseCtrlAppInfo ctrlAppInfo = do
+      CtrlAppInfo {deviceName, 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)
+    getHostAppInfo appVersion = do
+      hostDeviceName <- chatReadVar localDeviceName
+      encryptFiles <- chatReadVar encryptLocalFiles
+      pure HostAppInfo {appVersion, deviceName = hostDeviceName, encoding = localEncoding, encryptFiles}
 
-handleRemoteCommand :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> TBQueue ChatResponse -> HTTP2Request -> m ()
-handleRemoteCommand execChatCommand remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
+handleRemoteCommand :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> CtrlSessKeys -> TBQueue ChatResponse -> HTTP2Request -> m ()
+handleRemoteCommand execChatCommand _sessionKeys remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
   logDebug "handleRemoteCommand"
   liftRC (tryRemoteError parseRequest) >>= \case
     Right (getNext, rc) -> do
@@ -311,7 +342,7 @@ handleRemoteCommand execChatCommand remoteOutputQ HTTP2Request {request, reqBody
     parseRequest :: ExceptT RemoteProtocolError IO (GetChunk, RemoteCommand)
     parseRequest = do
       (header, getNext) <- parseHTTP2Body request reqBody
-      (getNext,) <$> liftEitherWith (RPEInvalidJSON . T.pack) (J.eitherDecodeStrict' header)
+      (getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecodeStrict' header)
     replyError = reply . RRChatResponse . CRChatCmdError Nothing
     processCommand :: User -> GetChunk -> RemoteCommand -> m ()
     processCommand user getNext = \case
@@ -329,6 +360,9 @@ handleRemoteCommand execChatCommand remoteOutputQ HTTP2Request {request, reqBody
         attach send
         flush
 
+takeRCStep :: ChatMonad m => RCStepTMVar a -> m a
+takeRCStep = liftEitherError (\e -> ChatErrorAgent {agentError = RCP e, connectionEntity_ = Nothing}) . atomically . takeTMVar
+
 type GetChunk = Int -> IO ByteString
 
 type SendChunk = Builder -> IO ()
@@ -393,83 +427,79 @@ handleGetFile User {userId} RemoteFile {userId = commandUserId, fileId, sent, fi
 
 discoverRemoteCtrls :: ChatMonad m => TM.TMap C.KeyHash (TransportHost, Word16) -> m ()
 discoverRemoteCtrls discovered = do
-  subscribers <- asks multicastSubscribers
-  Discovery.withListener subscribers run
-  where
-    run sock = receive sock >>= process sock
-
-    receive sock =
-      Discovery.recvAnnounce sock >>= \case
-        (SockAddrInet _sockPort sockAddr, sigAnnBytes) -> case smpDecode sigAnnBytes of
-          Right (SignedAnnounce ann _sig) -> pure (sockAddr, ann)
-          Left _ -> receive sock -- TODO it is probably better to report errors to view here
-        _nonV4 -> receive sock
-
-    process sock (sockAddr, Announce {caFingerprint, serviceAddress = (annAddr, port)}) = do
-      unless (annAddr == sockAddr) $ logError "Announced address doesn't match socket address"
-      let addr = THIPv4 (hostAddressToTuple sockAddr)
-      ifM
-        (atomically $ TM.member caFingerprint discovered)
-        (logDebug $ "Fingerprint already known: " <> tshow (addr, caFingerprint))
-        ( do
-            logInfo $ "New fingerprint announced: " <> tshow (addr, caFingerprint)
-            atomically $ TM.insert caFingerprint (addr, port) discovered
-        )
-      -- TODO we check fingerprint for duplicate where id doesn't matter - to prevent re-insert - and don't check to prevent duplicate events,
-      -- so UI now will have to check for duplicates again
-      withStore' (`getRemoteCtrlByFingerprint` caFingerprint) >>= \case
-        Nothing -> toView $ CRRemoteCtrlAnnounce caFingerprint -- unknown controller, ui "register" action required
-        -- TODO Maybe Bool is very confusing - the intent is very unclear here
-        Just found@RemoteCtrl {remoteCtrlId, accepted = storedChoice} -> case storedChoice of
-          Nothing -> toView $ CRRemoteCtrlFound $ remoteCtrlInfo found False -- first-time controller, ui "accept" action required
-          Just False -> run sock -- restart, skipping a rejected item
-          Just True ->
-            chatReadVar remoteCtrlSession >>= \case
-              Nothing -> toView . CRChatError Nothing . ChatError $ CEInternalError "Remote host found without running a session"
-              Just RemoteCtrlSession {confirmed} -> atomically $ void $ tryPutTMVar confirmed remoteCtrlId -- previously accepted controller, connect automatically
+  error "TODO: discoverRemoteCtrls"
 
 listRemoteCtrls :: ChatMonad m => m [RemoteCtrlInfo]
 listRemoteCtrls = do
-  active <-
-    chatReadVar remoteCtrlSession $>>= \RemoteCtrlSession {confirmed} ->
-      atomically $ tryReadTMVar confirmed
+  active <- chatReadVar remoteCtrlSession >>= \case
+    Just RCSessionConnected {remoteCtrlId} -> pure $ Just remoteCtrlId
+    _ -> pure Nothing
   map (rcInfo active) <$> withStore' getRemoteCtrls
   where
     rcInfo activeRcId rc@RemoteCtrl {remoteCtrlId} =
       remoteCtrlInfo rc $ activeRcId == Just remoteCtrlId
 
 remoteCtrlInfo :: RemoteCtrl -> Bool -> RemoteCtrlInfo
-remoteCtrlInfo RemoteCtrl {remoteCtrlId, displayName, fingerprint, accepted} sessionActive =
-  RemoteCtrlInfo {remoteCtrlId, displayName, fingerprint, accepted, sessionActive}
+remoteCtrlInfo RemoteCtrl {remoteCtrlId, ctrlName} sessionActive =
+  RemoteCtrlInfo {remoteCtrlId, ctrlName, sessionActive}
 
+-- XXX: only used for multicast
 confirmRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
-confirmRemoteCtrl rcId = do
+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
+  -- RemoteCtrlSession {confirmed} <- getRemoteCtrlSession
+  -- withStore' $ \db -> markRemoteCtrlResolution db rcId True
+  -- atomically . void $ tryPutTMVar confirmed rcId -- the remote host can now proceed with connection
+  undefined
 
-verifyRemoteCtrlSession :: ChatMonad m => RemoteCtrlId -> Text -> m ()
-verifyRemoteCtrlSession rcId sessId = do
-  RemoteCtrlSession {verified} <- getRemoteCtrlSession
-  void . atomically $ tryPutTMVar verified (rcId, sessId)
+-- | 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' = do
+  (client, ctrlName, sessionCode, vars) <-
+    getRemoteCtrlSession >>= \case
+      RCSessionPendingConfirmation {rcsClient, ctrlName, sessionCode, rcsWaitConfirmation} -> pure (rcsClient, ctrlName, sessionCode, rcsWaitConfirmation)
+      _ -> throwError $ ChatErrorRemoteCtrl RCEBadState
+  let verified = sameVerificationCode sessCode' sessionCode
+  liftIO $ confirmCtrlSession client verified
+  unless verified $ throwError $ ChatErrorRemoteCtrl RCEBadVerificationCode
+  (rcsSession@RCCtrlSession {tls, sessionKeys}, rcCtrlPairing) <- takeRCStep vars
+  rc@RemoteCtrl {remoteCtrlId} <- withStore $ \db -> do
+    rc_ <- liftIO $ getRemoteCtrlByFingerprint db (ctrlFingerprint rcCtrlPairing)
+    case rc_ of
+      Nothing -> insertRemoteCtrl db ctrlName rcCtrlPairing >>= getRemoteCtrl db
+      Just rc@RemoteCtrl {remoteCtrlId} -> do
+        liftIO $ updateCtrlPairingKeys db remoteCtrlId (dhPrivKey rcCtrlPairing)
+        pure rc
+  remoteOutputQ <- asks (tbqSize . config) >>= newTBQueueIO
+  http2Server <- async $ attachHTTP2Server tls $ handleRemoteCommand execChatCommand sessionKeys remoteOutputQ
+  withRemoteCtrlSession $ \case
+    RCSessionPendingConfirmation {} -> Right ((), RCSessionConnected {remoteCtrlId, rcsClient = client, rcsSession, http2Server, remoteOutputQ})
+    _ -> Left $ ChatErrorRemoteCtrl RCEBadState
+  void . forkIO $ do
+    waitCatch http2Server >>= \case
+      Left err | Just (BadThingHappen innerErr) <- fromException err -> logWarn $ "HTTP2 server crashed with internal " <> tshow innerErr
+      Left err | isNothing (fromException @AsyncCancelled err) -> logError $ "HTTP2 server crashed with " <> tshow err
+      _ -> logInfo "HTTP2 server stopped"
+    toView CRRemoteCtrlStopped
+  pure $ remoteCtrlInfo rc True
 
 stopRemoteCtrl :: ChatMonad m => m ()
-stopRemoteCtrl = do
-  rcs <- getRemoteCtrlSession
-  cancelRemoteCtrlSession rcs $ chatWriteVar remoteCtrlSession Nothing
+stopRemoteCtrl =
+  join . withRemoteCtrlSession_ . maybe (Left $ ChatErrorRemoteCtrl RCEInactive) $
+    \s -> Right (liftIO $ cancelRemoteCtrl s, Nothing)
 
-cancelRemoteCtrlSession_ :: MonadUnliftIO m => RemoteCtrlSession -> m ()
-cancelRemoteCtrlSession_ rcs = cancelRemoteCtrlSession rcs $ pure ()
-
-cancelRemoteCtrlSession :: MonadUnliftIO m => RemoteCtrlSession -> m () -> m ()
-cancelRemoteCtrlSession RemoteCtrlSession {discoverer, supervisor, hostServer} cleanup = do
-  cancel discoverer -- may be gone by now
-  case hostServer of
-    Just host -> cancel host -- supervisor will clean up
-    Nothing -> do
-      cancel supervisor -- supervisor is blocked until session progresses
-      cleanup
+cancelRemoteCtrl :: RemoteCtrlSession -> IO ()
+cancelRemoteCtrl = \case
+  RCSessionStarting -> pure ()
+  RCSessionConnecting {rcsClient, rcsWaitSession} -> do
+    cancelCtrlClient rcsClient
+    uninterruptibleCancel rcsWaitSession
+  RCSessionPendingConfirmation {rcsClient, rcsWaitSession} -> do
+    cancelCtrlClient rcsClient
+    uninterruptibleCancel rcsWaitSession
+  RCSessionConnected {rcsClient, http2Server} -> do
+    cancelCtrlClient rcsClient
+    uninterruptibleCancel http2Server
 
 deleteRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
 deleteRemoteCtrl rcId = do
@@ -485,6 +515,23 @@ checkNoRemoteCtrlSession :: ChatMonad m => m ()
 checkNoRemoteCtrlSession =
   chatReadVar remoteCtrlSession >>= maybe (pure ()) (\_ -> throwError $ ChatErrorRemoteCtrl RCEBusy)
 
+withRemoteCtrlSession :: ChatMonad m => (RemoteCtrlSession -> Either ChatError (a, RemoteCtrlSession)) -> m a
+withRemoteCtrlSession state = withRemoteCtrlSession_ $ maybe (Left $ ChatErrorRemoteCtrl RCEInactive) ((second . second) Just . state)
+
+-- | Atomically process controller state wrt. specific remote ctrl session
+withRemoteCtrlSession_ :: ChatMonad m => (Maybe RemoteCtrlSession -> Either ChatError (a, Maybe RemoteCtrlSession)) -> m a
+withRemoteCtrlSession_ state = do
+  session <- asks remoteCtrlSession
+  r <-
+    atomically $ stateTVar session $ \s ->
+      case state s of
+        Left e -> (Left e, s)
+        Right (a, s') -> (Right a, s')
+  liftEither r
+
+updateRemoteCtrlSession :: ChatMonad m => (RemoteCtrlSession -> Either ChatError RemoteCtrlSession) -> m ()
+updateRemoteCtrlSession state = withRemoteCtrlSession $ fmap ((),) . state
+
 utf8String :: [Char] -> ByteString
 utf8String = encodeUtf8 . T.pack
 {-# INLINE utf8String #-}
diff --git a/src/Simplex/Chat/Remote/AppVersion.hs b/src/Simplex/Chat/Remote/AppVersion.hs
new file mode 100644
index 000000000..a8943968d
--- /dev/null
+++ b/src/Simplex/Chat/Remote/AppVersion.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Chat.Remote.AppVersion
+  ( AppVersionRange (minVersion, maxVersion),
+    AppVersion (..),
+    pattern AppCompatible,
+    mkAppVersionRange,
+    compatibleAppVersion,
+    isAppCompatible,
+  )
+  where
+
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as J
+import qualified Data.Aeson.Encoding as JE
+import qualified Data.Aeson.TH as JQ
+import qualified Data.Text as T
+import Data.Version (parseVersion, showVersion)
+import qualified Data.Version as V
+import Simplex.Messaging.Parsers (defaultJSON)
+import Text.ParserCombinators.ReadP (readP_to_S)
+
+newtype AppVersion = AppVersion V.Version
+  deriving (Eq, Ord, Show)
+
+instance ToJSON AppVersion where
+  toJSON (AppVersion v) = J.String . T.pack $ showVersion v
+  toEncoding (AppVersion v) = JE.text . T.pack $ showVersion v
+
+instance FromJSON AppVersion where
+  parseJSON = J.withText "AppVersion" $ parse . T.unpack
+    where
+      parse s = case filter (null . snd) $ readP_to_S parseVersion s of
+        (v, _) : _ -> pure $ AppVersion v
+        _ -> fail $ "bad AppVersion: " <> s
+
+data AppVersionRange = AppVRange
+  { minVersion :: AppVersion,
+    maxVersion :: AppVersion
+  }
+
+mkAppVersionRange :: AppVersion -> AppVersion -> AppVersionRange
+mkAppVersionRange v1 v2
+  | v1 <= v2 = AppVRange v1 v2
+  | otherwise = error "invalid version range"
+
+newtype AppCompatible a = AppCompatible_ a
+
+pattern AppCompatible :: a -> AppCompatible a
+pattern AppCompatible a <- AppCompatible_ a
+
+{-# COMPLETE AppCompatible #-}
+
+isAppCompatible :: AppVersion -> AppVersionRange -> Bool
+isAppCompatible v (AppVRange v1 v2) = v1 <= v && v <= v2
+
+isCompatibleAppRange :: AppVersionRange -> AppVersionRange -> Bool
+isCompatibleAppRange (AppVRange min1 max1) (AppVRange min2 max2) = min1 <= max2 && min2 <= max1
+
+compatibleAppVersion :: AppVersionRange -> AppVersionRange -> Maybe (AppCompatible AppVersion)
+compatibleAppVersion vr1 vr2 =
+  min (maxVersion vr1) (maxVersion vr2) `mkCompatibleIf` isCompatibleAppRange vr1 vr2
+
+mkCompatibleIf :: AppVersion -> Bool -> Maybe (AppCompatible AppVersion)
+v `mkCompatibleIf` cond = if cond then Just $ AppCompatible_ v else Nothing
+
+$(JQ.deriveJSON defaultJSON ''AppVersionRange)
diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs
index 45bea6066..2868a4510 100644
--- a/src/Simplex/Chat/Remote/Protocol.hs
+++ b/src/Simplex/Chat/Remote/Protocol.hs
@@ -19,7 +19,7 @@ import qualified Data.Aeson.KeyMap as JM
 import Data.Aeson.TH (deriveJSON)
 import qualified Data.Aeson.Types as JT
 import Data.ByteString (ByteString)
-import Data.ByteString.Builder (Builder, word32BE, lazyByteString)
+import Data.ByteString.Builder (Builder, lazyByteString, word32BE)
 import qualified Data.ByteString.Lazy as LB
 import Data.String (fromString)
 import Data.Text (Text)
@@ -39,7 +39,8 @@ import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), HTTP2BodyChunk, getBod
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2Response (..), closeHTTP2Client, sendRequestDirect)
 import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
 import Simplex.Messaging.Util (liftEitherError, liftEitherWith, tshow)
-import System.FilePath ((</>), takeFileName)
+import Simplex.RemoteControl.Types (HostSessKeys)
+import System.FilePath (takeFileName, (</>))
 import UnliftIO
 
 data RemoteCommand
@@ -66,14 +67,21 @@ $(deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse)
 
 -- * Client side / desktop
 
-createRemoteHostClient :: HTTP2Client -> dh -> Text -> ExceptT RemoteProtocolError IO RemoteHostClient
-createRemoteHostClient httpClient todo'dhKey desktopName = do
+createRemoteHostClient :: HTTP2Client -> HostSessKeys -> FilePath -> Text -> ExceptT RemoteProtocolError IO RemoteHostClient
+createRemoteHostClient httpClient sessionKeys storePath desktopName = do
   logDebug "Sending initial hello"
   sendRemoteCommand' httpClient localEncoding Nothing RCHello {deviceName = desktopName} >>= \case
     RRHello {encoding, deviceName = mobileName, encryptFiles} -> do
       logDebug "Got initial hello"
       when (encoding == PEKotlin && localEncoding == PESwift) $ throwError RPEIncompatibleEncoding
-      pure RemoteHostClient {hostEncoding = encoding, hostDeviceName = mobileName, httpClient, encryptHostFiles = encryptFiles}
+      pure RemoteHostClient
+        { hostEncoding = encoding,
+          hostDeviceName = mobileName,
+          httpClient,
+          encryptHostFiles = encryptFiles,
+          sessionKeys,
+          storePath
+        }
     r -> badResponse r
 
 closeRemoteHostClient :: MonadIO m => RemoteHostClient -> m ()
diff --git a/src/Simplex/Chat/Remote/RevHTTP.hs b/src/Simplex/Chat/Remote/RevHTTP.hs
index 08c844dcf..a37d77e20 100644
--- a/src/Simplex/Chat/Remote/RevHTTP.hs
+++ b/src/Simplex/Chat/Remote/RevHTTP.hs
@@ -8,37 +8,20 @@
 
 module Simplex.Chat.Remote.RevHTTP where
 
-import Simplex.RemoteControl.Discovery
-import Simplex.RemoteControl.Types
-import Control.Logger.Simple
-import qualified Network.TLS as TLS
-import qualified Simplex.Messaging.Crypto as C
-import qualified Simplex.Messaging.Transport as Transport
+import Simplex.Messaging.Transport (TLS)
 import Simplex.Messaging.Transport.HTTP2 (defaultHTTP2BufferSize, getHTTP2Body)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError (..), attachHTTP2Client, bodyHeadSize, connTimeout, defaultHTTP2ClientConfig)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..), runHTTP2ServerWith)
-import Simplex.Messaging.Util (ifM)
+import Simplex.RemoteControl.Discovery
 import UnliftIO
 
-announceRevHTTP2 :: MonadUnliftIO m => Tasks -> (C.PrivateKeyEd25519, Announce) -> TLS.Credentials -> m () -> m (Either HTTP2ClientError HTTP2Client)
-announceRevHTTP2 = announceCtrl runHTTP2Client
-
--- | Attach HTTP2 client and hold the TLS until the attached client finishes.
-runHTTP2Client :: MVar () -> MVar (Either HTTP2ClientError HTTP2Client) -> Transport.TLS -> IO ()
-runHTTP2Client finishedVar clientVar tls =
-  ifM (isEmptyMVar clientVar)
-    attachClient
-    (logError "HTTP2 session already started on this listener")
+attachRevHTTP2Client :: IO () -> TLS -> IO (Either HTTP2ClientError HTTP2Client)
+attachRevHTTP2Client disconnected = attachHTTP2Client config ANY_ADDR_V4 "0" disconnected defaultHTTP2BufferSize
   where
-    attachClient = do
-      client <- attachHTTP2Client config ANY_ADDR_V4 DISCOVERY_PORT (putMVar finishedVar ()) defaultHTTP2BufferSize tls
-      putMVar clientVar client
-      readMVar finishedVar
-    -- TODO connection timeout
     config = defaultHTTP2ClientConfig {bodyHeadSize = doNotPrefetchHead, connTimeout = maxBound}
 
-attachHTTP2Server :: (MonadUnliftIO m) => (HTTP2Request -> m ()) -> Transport.TLS -> m ()
-attachHTTP2Server processRequest tls = do
+attachHTTP2Server :: MonadUnliftIO m => TLS -> (HTTP2Request -> m ()) -> m ()
+attachHTTP2Server tls processRequest = do
   withRunInIO $ \unlift ->
     runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
       reqBody <- getHTTP2Body r doNotPrefetchHead
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index dcf70ab71..d9aa9d50b 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -9,34 +9,45 @@
 
 module Simplex.Chat.Remote.Types where
 
+import Control.Concurrent.Async (Async)
 import Control.Exception (Exception)
 import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
 import Data.Text (Text)
-import qualified Simplex.Messaging.Crypto as C
+import Simplex.Chat.Remote.AppVersion
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
-import Simplex.RemoteControl.Types (Tasks)
+import Simplex.RemoteControl.Client
+import Simplex.RemoteControl.Types
 import Simplex.Messaging.Crypto.File (CryptoFile)
 
 data RemoteHostClient = RemoteHostClient
   { hostEncoding :: PlatformEncoding,
     hostDeviceName :: Text,
     httpClient :: HTTP2Client,
-    encryptHostFiles :: Bool
-  }
-
-data RemoteHostSession = RemoteHostSession
-  { remoteHostTasks :: Tasks,
-    remoteHostClient :: Maybe RemoteHostClient,
+    sessionKeys :: HostSessKeys,
+    encryptHostFiles :: Bool,
     storePath :: FilePath
   }
 
+data RHPendingSession = RHPendingSession
+  { rhKey :: RHKey,
+    rchClient :: RCHostClient,
+    rhsWaitSession :: Async (),
+    remoteHost_ :: Maybe RemoteHostInfo
+  }
+
+data RemoteHostSession
+  = RHSessionStarting
+  | RHSessionConnecting {rhPendingSession :: RHPendingSession}
+  | RHSessionConfirmed {rhPendingSession :: RHPendingSession}
+  | RHSessionConnected {rhClient :: RemoteHostClient, pollAction :: Async (), storePath :: FilePath}
+
 data RemoteProtocolError
   = -- | size prefix is malformed
     RPEInvalidSize
   | -- | failed to parse RemoteCommand or RemoteResponse
-    RPEInvalidJSON {invalidJSON :: Text}
+    RPEInvalidJSON {invalidJSON :: String}
   | RPEIncompatibleEncoding
   | RPEUnexpectedFile
   | RPENoFile
@@ -52,47 +63,39 @@ data RemoteProtocolError
 
 type RemoteHostId = Int64
 
+data RHKey = RHNew | RHId {remoteHostId :: RemoteHostId}
+  deriving (Eq, Ord, Show)
+
+-- | Storable/internal remote host data
 data RemoteHost = RemoteHost
   { remoteHostId :: RemoteHostId,
+    hostName :: Text,
     storePath :: FilePath,
-    displayName :: Text,
-    -- | Credentials signing key for root and session certs
-    caKey :: C.APrivateSignKey,
-    -- | A stable part of TLS credentials used in remote session
-    caCert :: C.SignedCertificate,
-    contacted :: Bool
+    hostPairing :: RCHostPairing
   }
-  deriving (Show)
-
-data RemoteCtrlOOB = RemoteCtrlOOB
-  { fingerprint :: C.KeyHash,
-    displayName :: Text
-  }
-  deriving (Show)
 
+-- | UI-accessible remote host information
 data RemoteHostInfo = RemoteHostInfo
   { remoteHostId :: RemoteHostId,
+    hostName :: Text,
     storePath :: FilePath,
-    displayName :: Text,
     sessionActive :: Bool
   }
   deriving (Show)
 
 type RemoteCtrlId = Int64
 
+-- | Storable/internal remote controller data
 data RemoteCtrl = RemoteCtrl
   { remoteCtrlId :: RemoteCtrlId,
-    displayName :: Text,
-    fingerprint :: C.KeyHash,
-    accepted :: Maybe Bool
+    ctrlName :: Text,
+    ctrlPairing :: RCCtrlPairing
   }
-  deriving (Show)
 
+-- | UI-accessible remote controller information
 data RemoteCtrlInfo = RemoteCtrlInfo
   { remoteCtrlId :: RemoteCtrlId,
-    displayName :: Text,
-    fingerprint :: C.KeyHash,
-    accepted :: Maybe Bool,
+    ctrlName :: Text,
     sessionActive :: Bool
   }
   deriving (Show)
@@ -117,14 +120,30 @@ data RemoteFile = RemoteFile
   }
   deriving (Show)
 
+data CtrlAppInfo = CtrlAppInfo
+  { appVersionRange :: AppVersionRange,
+    deviceName :: Text
+  }
+
+data HostAppInfo = HostAppInfo
+  { appVersion :: AppVersion,
+    deviceName :: Text,
+    encoding :: PlatformEncoding,
+    encryptFiles :: Bool -- if the host encrypts files in app storage
+  }
+
 $(J.deriveJSON defaultJSON ''RemoteFile)
 
 $(J.deriveJSON (sumTypeJSON $ dropPrefix "RPE") ''RemoteProtocolError)
 
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "RH") ''RHKey)
+
 $(J.deriveJSON (enumJSON $ dropPrefix "PE") ''PlatformEncoding)
 
 $(J.deriveJSON defaultJSON ''RemoteHostInfo)
 
-$(J.deriveJSON defaultJSON ''RemoteCtrl)
-
 $(J.deriveJSON defaultJSON ''RemoteCtrlInfo)
+
+$(J.deriveJSON defaultJSON ''CtrlAppInfo)
+
+$(J.deriveJSON defaultJSON ''HostAppInfo)
diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs
index df7ccd499..e12b58125 100644
--- a/src/Simplex/Chat/Store/Remote.hs
+++ b/src/Simplex/Chat/Store/Remote.hs
@@ -1,26 +1,39 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 
 module Simplex.Chat.Store.Remote where
 
 import Control.Monad.Except
 import Data.Int (Int64)
-import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Database.SQLite.Simple (Only (..))
 import qualified Database.SQLite.Simple as SQL
+import Database.SQLite.Simple.QQ (sql)
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store.Shared
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.RemoteControl.Types
+import UnliftIO
 
-insertRemoteHost :: DB.Connection -> FilePath -> Text -> C.APrivateSignKey -> C.SignedCertificate -> IO RemoteHostId
-insertRemoteHost db storePath displayName caKey caCert = do
-  DB.execute db "INSERT INTO remote_hosts (store_path, display_name, ca_key, ca_cert) VALUES (?,?,?,?)" (storePath, displayName, caKey, C.SignedObject caCert)
-  insertedRowId db
+insertRemoteHost :: DB.Connection -> Text -> FilePath -> RCHostPairing -> ExceptT StoreError IO RemoteHostId
+insertRemoteHost db hostDeviceName storePath RCHostPairing {caKey, caCert, idPrivKey, knownHost = kh_} = do
+  KnownHostPairing {hostFingerprint, hostDhPubKey} <-
+    maybe (throwError SERemoteHostUnknown) pure kh_
+  checkConstraint SERemoteHostDuplicateCA . liftIO $
+    DB.execute
+      db
+      [sql|
+        INSERT INTO remote_hosts
+          (host_device_name, store_path, ca_key, ca_cert, id_key, host_fingerprint, host_dh_pub)
+        VALUES
+          (?, ?, ?, ?, ?, ?, ?)
+      |]
+      (hostDeviceName, storePath, caKey, C.SignedObject caCert, idPrivKey, hostFingerprint, hostDhPubKey)
+  liftIO $ insertedRowId db
 
 getRemoteHosts :: DB.Connection -> IO [RemoteHost]
 getRemoteHosts db =
@@ -31,22 +44,52 @@ getRemoteHost db remoteHostId =
   ExceptT . firstRow toRemoteHost (SERemoteHostNotFound remoteHostId) $
     DB.query db (remoteHostQuery <> " WHERE remote_host_id = ?") (Only remoteHostId)
 
-remoteHostQuery :: SQL.Query
-remoteHostQuery = "SELECT remote_host_id, store_path, display_name, ca_key, ca_cert, contacted FROM remote_hosts"
+getRemoteHostByFingerprint :: DB.Connection -> C.KeyHash -> IO (Maybe RemoteHost)
+getRemoteHostByFingerprint db fingerprint =
+  maybeFirstRow toRemoteHost $
+    DB.query db (remoteHostQuery <> " WHERE host_fingerprint = ?") (Only fingerprint)
 
-toRemoteHost :: (Int64, FilePath, Text, C.APrivateSignKey, C.SignedObject C.Certificate, Bool) -> RemoteHost
-toRemoteHost (remoteHostId, storePath, displayName, caKey, C.SignedObject caCert, contacted) =
-  RemoteHost {remoteHostId, storePath, displayName, caKey, caCert, contacted}
+remoteHostQuery :: SQL.Query
+remoteHostQuery =
+  [sql|
+    SELECT remote_host_id, host_device_name, store_path, ca_key, ca_cert, id_key, host_fingerprint, host_dh_pub
+    FROM remote_hosts
+  |]
+
+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}
+  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 =
+  DB.execute
+    db
+    [sql|
+      UPDATE remote_hosts
+      SET host_device_name = ?, host_dh_pub = ?
+      WHERE remote_host_id = ?
+    |]
+    (hostName, hostDhPubKey, rhId)
 
 deleteRemoteHostRecord :: DB.Connection -> RemoteHostId -> IO ()
 deleteRemoteHostRecord db remoteHostId = DB.execute db "DELETE FROM remote_hosts WHERE remote_host_id = ?" (Only remoteHostId)
 
-insertRemoteCtrl :: DB.Connection -> SignedOOB -> IO RemoteCtrlInfo
-insertRemoteCtrl db (SignedOOB OOB {deviceName, caFingerprint = fingerprint} _) = do
-  let displayName = fromMaybe "" deviceName
-  DB.execute db "INSERT INTO remote_controllers (display_name, fingerprint) VALUES (?,?)" (displayName, fingerprint)
-  remoteCtrlId <- insertedRowId db
-  pure RemoteCtrlInfo {remoteCtrlId, displayName, fingerprint, accepted = Nothing, sessionActive = False}
+insertRemoteCtrl :: DB.Connection -> Text -> RCCtrlPairing -> ExceptT StoreError IO RemoteCtrlId
+insertRemoteCtrl db ctrlDeviceName RCCtrlPairing {caKey, caCert, ctrlFingerprint, idPubKey, dhPrivKey, prevDhPrivKey} = do
+  checkConstraint SERemoteCtrlDuplicateCA . liftIO $
+    DB.execute
+      db
+      [sql|
+      INSERT INTO remote_controllers
+        (ctrl_device_name, ca_key, ca_cert, ctrl_fingerprint, id_pub, dh_priv_key, prev_dh_priv_key)
+      VALUES
+        (?, ?, ?, ?, ?, ?, ?)
+    |]
+      (ctrlDeviceName, caKey, C.SignedObject caCert, ctrlFingerprint, idPubKey, dhPrivKey, prevDhPrivKey)
+  liftIO $ insertedRowId db
 
 getRemoteCtrls :: DB.Connection -> IO [RemoteCtrl]
 getRemoteCtrls db =
@@ -55,24 +98,49 @@ getRemoteCtrls db =
 getRemoteCtrl :: DB.Connection -> RemoteCtrlId -> ExceptT StoreError IO RemoteCtrl
 getRemoteCtrl db remoteCtrlId =
   ExceptT . firstRow toRemoteCtrl (SERemoteCtrlNotFound remoteCtrlId) $
-    DB.query db (remoteCtrlQuery <> " WHERE remote_controller_id = ?") (Only remoteCtrlId)
+    DB.query db (remoteCtrlQuery <> " WHERE remote_ctrl_id = ?") (Only remoteCtrlId)
 
 getRemoteCtrlByFingerprint :: DB.Connection -> C.KeyHash -> IO (Maybe RemoteCtrl)
 getRemoteCtrlByFingerprint db fingerprint =
   maybeFirstRow toRemoteCtrl $
-    DB.query db (remoteCtrlQuery <> " WHERE fingerprint = ?") (Only fingerprint)
+    DB.query db (remoteCtrlQuery <> " WHERE ctrl_fingerprint = ?") (Only fingerprint)
 
 remoteCtrlQuery :: SQL.Query
-remoteCtrlQuery = "SELECT remote_controller_id, display_name, fingerprint, accepted FROM remote_controllers"
+remoteCtrlQuery =
+  [sql|
+    SELECT remote_ctrl_id, ctrl_device_name, ca_key, ca_cert, ctrl_fingerprint, id_pub, dh_priv_key, prev_dh_priv_key
+    FROM remote_controllers
+  |]
 
-toRemoteCtrl :: (Int64, Text, C.KeyHash, Maybe Bool) -> RemoteCtrl
-toRemoteCtrl (remoteCtrlId, displayName, fingerprint, accepted) =
-  RemoteCtrl {remoteCtrlId, displayName, fingerprint, accepted}
+toRemoteCtrl ::
+  ( RemoteCtrlId,
+    Text,
+    C.APrivateSignKey,
+    C.SignedObject C.Certificate,
+    C.KeyHash,
+    C.PublicKeyEd25519,
+    C.PrivateKeyX25519,
+    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}
+    }
 
-markRemoteCtrlResolution :: DB.Connection -> RemoteCtrlId -> Bool -> IO ()
-markRemoteCtrlResolution db remoteCtrlId accepted =
-  DB.execute db "UPDATE remote_controllers SET accepted = ? WHERE remote_controller_id = ? AND accepted IS NULL" (accepted, remoteCtrlId)
+updateCtrlPairingKeys :: DB.Connection -> RemoteCtrlId -> C.PrivateKeyX25519 -> IO ()
+updateCtrlPairingKeys db rcId dhPrivKey =
+  DB.execute
+    db
+    [sql|
+      UPDATE remote_controllers
+      SET dh_priv_key = ?, prev_dh_priv_key = dh_priv_key
+      WHERE remote_ctrl_id = ?
+    |]
+    (dhPrivKey, rcId)
 
 deleteRemoteCtrlRecord :: DB.Connection -> RemoteCtrlId -> IO ()
 deleteRemoteCtrlRecord db remoteCtrlId =
-  DB.execute db "DELETE FROM remote_controllers WHERE remote_controller_id = ?" (Only remoteCtrlId)
+  DB.execute db "DELETE FROM remote_controllers WHERE remote_ctrl_id = ?" (Only remoteCtrlId)
diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs
index e72d68b8d..ab7330454 100644
--- a/src/Simplex/Chat/Store/Shared.hs
+++ b/src/Simplex/Chat/Store/Shared.hs
@@ -100,7 +100,10 @@ data StoreError
   | SEContactNotFoundByFileId {fileId :: FileTransferId}
   | SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId}
   | SERemoteHostNotFound {remoteHostId :: RemoteHostId}
+  | SERemoteHostUnknown -- ^ attempting to store KnownHost without a known fingerprint
+  | SERemoteHostDuplicateCA
   | SERemoteCtrlNotFound {remoteCtrlId :: RemoteCtrlId}
+  | SERemoteCtrlDuplicateCA
   deriving (Show, Exception)
 
 $(J.deriveJSON (sumTypeJSON $ dropPrefix "SE") ''StoreError)
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 572403e59..ca47cb15e 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -277,9 +277,16 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRNtfMessages {} -> []
   CRRemoteHostCreated RemoteHostInfo {remoteHostId} -> ["remote host " <> sShow remoteHostId <> " created"]
   CRRemoteHostList hs -> viewRemoteHosts hs
-  CRRemoteHostStarted {remoteHost = RemoteHostInfo {remoteHostId = rhId}, sessionOOB} -> ["remote host " <> sShow rhId <> " started", "connection code:", plain sessionOOB]
-  CRRemoteHostSessionCode {remoteHost = RemoteHostInfo {remoteHostId = rhId}, sessionCode} ->
-    ["remote host " <> sShow rhId <> " is connecting", "Compare session code with host:", plain sessionCode]
+  CRRemoteHostStarted {remoteHost_, invitation} ->
+    [ maybe "new remote host started" (\RemoteHostInfo {remoteHostId = rhId} -> "remote host " <> sShow rhId <> " started") remoteHost_,
+      "Remote session invitation:",
+      plain invitation
+    ]
+  CRRemoteHostSessionCode {remoteHost_, sessionCode} ->
+    [ maybe "new remote host connecting" (\RemoteHostInfo {remoteHostId = rhId} -> "remote host " <> sShow rhId <> " connecting") remoteHost_,
+      "Compare session code with host:",
+      plain sessionCode
+    ]
   CRRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} -> ["remote host " <> sShow rhId <> " connected"]
   CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
   CRRemoteFileStored rhId (CryptoFile filePath cfArgs_) ->
@@ -292,12 +299,15 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
     ["remote controller announced", "connection code:", plain $ strEncode fingerprint]
   CRRemoteCtrlFound rc ->
     ["remote controller found:", viewRemoteCtrl rc]
-  CRRemoteCtrlConnecting RemoteCtrlInfo {remoteCtrlId = rcId, displayName = rcName} ->
-    ["remote controller " <> sShow rcId <> " connecting to " <> plain rcName]
-  CRRemoteCtrlSessionCode {remoteCtrl = RemoteCtrlInfo {remoteCtrlId = rcId, displayName = rcName}, sessionCode} ->
-    ["remote controller " <> sShow rcId <> " connected to " <> plain rcName, "Compare session code with controller and use:", "/verify remote ctrl " <> sShow rcId <> " " <> plain sessionCode]
-  CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, displayName = rcName} ->
-    ["remote controller " <> sShow rcId <> " session started with " <> plain rcName]
+  CRRemoteCtrlConnecting RemoteCtrlInfo {remoteCtrlId = rcId, ctrlName} ->
+    ["remote controller " <> sShow rcId <> " connecting to " <> plain ctrlName]
+  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]
   CRRemoteCtrlStopped -> ["remote controller stopped"]
   CRSQLResult rows -> map plain rows
   CRSlowSQLQueries {chatQueries, agentQueries} ->
@@ -1681,21 +1691,21 @@ viewRemoteHosts = \case
   [] -> ["No remote hosts"]
   hs -> "Remote hosts: " : map viewRemoteHostInfo hs
   where
-    viewRemoteHostInfo RemoteHostInfo {remoteHostId, displayName, sessionActive} =
-      plain $ tshow remoteHostId <> ". " <> displayName <> if sessionActive then " (active)" else ""
+    viewRemoteHostInfo RemoteHostInfo {remoteHostId, hostName, sessionActive} =
+      plain $ tshow remoteHostId <> ". " <> hostName <> if sessionActive then " (active)" else ""
 
 viewRemoteCtrls :: [RemoteCtrlInfo] -> [StyledString]
 viewRemoteCtrls = \case
   [] -> ["No remote controllers"]
   hs -> "Remote controllers: " : map viewRemoteCtrlInfo hs
   where
-    viewRemoteCtrlInfo RemoteCtrlInfo {remoteCtrlId, displayName, sessionActive} =
-      plain $ tshow remoteCtrlId <> ". " <> displayName <> if sessionActive then " (active)" else ""
+    viewRemoteCtrlInfo RemoteCtrlInfo {remoteCtrlId, ctrlName, sessionActive} =
+      plain $ tshow remoteCtrlId <> ". " <> ctrlName <> if sessionActive then " (active)" else ""
 
 -- TODO fingerprint, accepted?
 viewRemoteCtrl :: RemoteCtrlInfo -> StyledString
-viewRemoteCtrl RemoteCtrlInfo {remoteCtrlId, displayName} =
-  plain $ tshow remoteCtrlId <> ". " <> displayName
+viewRemoteCtrl RemoteCtrlInfo {remoteCtrlId, ctrlName} =
+  plain $ tshow remoteCtrlId <> ". " <> ctrlName
 
 viewChatError :: ChatLogLevel -> ChatError -> [StyledString]
 viewChatError logLevel = \case
@@ -1843,7 +1853,8 @@ viewChatError logLevel = \case
       cId :: Connection -> StyledString
       cId conn = sShow conn.connId
   ChatErrorRemoteCtrl e -> [plain $ "remote controller error: " <> show e]
-  ChatErrorRemoteHost rhId e -> [plain $ "remote host " <> show rhId <> " error: " <> show e]
+  ChatErrorRemoteHost RHNew e -> [plain $ "new remote host error: " <> show e]
+  ChatErrorRemoteHost (RHId rhId) e -> [plain $ "remote host " <> show rhId <> " error: " <> show e]
   where
     fileNotFound fileId = ["file " <> sShow fileId <> " not found"]
     sqliteError' = \case
diff --git a/stack.yaml b/stack.yaml
index 9043a5695..4c26936c0 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: 1a0c4b73de5cda4ac6765dd47e0199238e498d5f
+    commit: 102487bc4fbb865aac4207d2ba6f2ea77eff3290
   - github: kazu-yamamoto/http2
     commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
   # - ../direct-sqlcipher
diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs
index ea455a0fc..f9e24727c 100644
--- a/tests/ChatClient.hs
+++ b/tests/ChatClient.hs
@@ -91,7 +91,7 @@ termSettings :: VirtualTerminalSettings
 termSettings =
   VirtualTerminalSettings
     { virtualType = "xterm",
-      virtualWindowSize = pure C.Size {height = 24, width = 1000},
+      virtualWindowSize = pure C.Size {height = 24, width = 2250},
       virtualEvent = retry,
       virtualInterrupt = retry
     }
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index b2e7aa5cb..83f7eeee5 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -1,13 +1,11 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module RemoteTests where
 
-import Simplex.Chat.Remote.RevHTTP
-import qualified Simplex.RemoteControl.Discovery as Discovery
-import Simplex.RemoteControl.Types
 import ChatClient
 import ChatTests.Utils
 import Control.Logger.Simple
@@ -16,11 +14,6 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as M
-import Data.String (fromString)
-import Network.HTTP.Types (ok200)
-import qualified Network.HTTP2.Client as C
-import qualified Network.HTTP2.Server as S
-import qualified Network.Socket as N
 import qualified Network.TLS as TLS
 import Simplex.Chat.Archive (archiveFilesFolder)
 import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..))
@@ -29,12 +22,8 @@ import Simplex.Chat.Mobile.File
 import Simplex.Chat.Remote.Types
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
-import Simplex.Messaging.Encoding (smpDecode)
 import Simplex.Messaging.Encoding.String (strEncode)
-import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
-import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Response (..), closeHTTP2Client, sendRequest)
-import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
 import Simplex.Messaging.Util
 import System.FilePath ((</>))
 import Test.Hspec
@@ -44,113 +33,35 @@ import UnliftIO.Directory
 
 remoteTests :: SpecWith FilePath
 remoteTests = describe "Remote" $ do
-  -- it "generates usable credentials" genCredentialsTest
-  -- it "OOB encoding, decoding, and signatures are correct" oobCodecTest
-  it "connects announcer with discoverer over reverse-http2" announceDiscoverHttp2Test
-  it "performs protocol handshake" remoteHandshakeTest
-  it "performs protocol handshake (again)" remoteHandshakeTest -- leaking servers regression check
+  describe "protocol handshake" $ do
+    it "connects with new pairing" remoteHandshakeTest
+    it "connects with new pairing (again)" remoteHandshakeTest -- leaking servers regression check
+    it "connects with stored pairing" remoteHandshakeStoredTest
   it "sends messages" remoteMessageTest
   describe "remote files" $ do
     it "store/get/send/receive files" remoteStoreFileTest
-    it "should sends files from CLI wihtout /store" remoteCLIFileTest
-
--- * Low-level TLS with ephemeral credentials
-
--- -- XXX: extract
--- genCredentialsTest :: (HasCallStack) => FilePath -> IO ()
--- genCredentialsTest _tmp = do
---   (fingerprint, credentials) <- genTestCredentials
---   started <- newEmptyTMVarIO
---   bracket (startTLSServer started credentials serverHandler) cancel $ \_server -> do
---     ok <- atomically (readTMVar started)
---     port <- maybe (error "TLS server failed to start") pure ok
---     logNote $ "Assigned port: " <> tshow port
---     connectTLSClient ("127.0.0.1", fromIntegral port) fingerprint clientHandler
---   where
---     serverHandler serverTls = do
---       logNote "Sending from server"
---       Transport.putLn serverTls "hi client"
---       logNote "Reading from server"
---       Transport.getLn serverTls `shouldReturn` "hi server"
---     clientHandler clientTls = do
---       logNote "Sending from client"
---       Transport.putLn clientTls "hi server"
---       logNote "Reading from client"
---       Transport.getLn clientTls `shouldReturn` "hi client"
-
--- * UDP discovery and rever HTTP2
-
--- oobCodecTest :: (HasCallStack) => FilePath -> IO ()
--- oobCodecTest _tmp = do
---   subscribers <- newTMVarIO 0
---   localAddr <- Discovery.getLocalAddress subscribers >>= maybe (fail "unable to get local address") pure
---   (fingerprint, _credentials) <- genTestCredentials
---   (_dhKey, _sigKey, _ann, signedOOB@(SignedOOB oob _sig)) <- Discovery.startSession (Just "Desktop") (localAddr, read Discovery.DISCOVERY_PORT) fingerprint
---   verifySignedOOB signedOOB `shouldBe` True
---   strDecode (strEncode oob) `shouldBe` Right oob
---   strDecode (strEncode signedOOB) `shouldBe` Right signedOOB
-
-announceDiscoverHttp2Test :: (HasCallStack) => FilePath -> IO ()
-announceDiscoverHttp2Test _tmp = do
-  subscribers <- newTMVarIO 0
-  localAddr <- Discovery.getLocalAddress subscribers >>= maybe (fail "unable to get local address") pure
-  (fingerprint, credentials) <- genTestCredentials
-  (_dhKey, sigKey, ann, _oob) <- Discovery.startSession (Just "Desktop") (localAddr, read Discovery.DISCOVERY_PORT) fingerprint
-  tasks <- newTVarIO []
-  finished <- newEmptyMVar
-  controller <- async $ do
-    logNote "Controller: starting"
-    bracket
-      (announceRevHTTP2 tasks (sigKey, ann) credentials (putMVar finished ()) >>= either (fail . show) pure)
-      closeHTTP2Client
-      ( \http -> do
-          logNote "Controller: got client"
-          sendRequest http (C.requestNoBody "GET" "/" []) (Just 10000000) >>= \case
-            Left err -> do
-              logNote "Controller: got error"
-              fail $ show err
-            Right HTTP2Response {} ->
-              logNote "Controller: got response"
-      )
-  host <- async $ Discovery.withListener subscribers $ \sock -> do
-    (N.SockAddrInet _port addr, sigAnn) <- Discovery.recvAnnounce sock
-    SignedAnnounce Announce {caFingerprint, serviceAddress=(hostAddr, port)} _sig <- either fail pure $ smpDecode sigAnn
-    caFingerprint `shouldBe` fingerprint
-    addr `shouldBe` hostAddr
-    let service = (THIPv4 $ N.hostAddressToTuple hostAddr, port)
-    logNote $ "Host: connecting to " <> tshow service
-    server <- async $ Discovery.connectTLSClient service fingerprint $ \tls -> do
-      logNote "Host: got tls"
-      flip attachHTTP2Server tls $ \HTTP2Request {sendResponse} -> do
-        logNote "Host: got request"
-        sendResponse $ S.responseNoBody ok200 []
-        logNote "Host: sent response"
-    takeMVar finished `finally` cancel server
-    logNote "Host: finished"
-  tasks `registerAsync` controller
-  tasks `registerAsync` host
-  (waitBoth host controller `shouldReturn` ((), ())) `finally` cancelTasks tasks
+    it "should send files from CLI wihtout /store" remoteCLIFileTest
 
 -- * Chat commands
 
-remoteHandshakeTest :: (HasCallStack) => FilePath -> IO ()
-remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
+remoteHandshakeTest :: HasCallStack => FilePath -> IO ()
+remoteHandshakeTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
   desktop ##> "/list remote hosts"
   desktop <## "No remote hosts"
+  mobile ##> "/list remote ctrls"
+  mobile <## "No remote controllers"
 
   startRemote mobile desktop
 
-  logNote "Session active"
-
   desktop ##> "/list remote hosts"
   desktop <## "Remote hosts:"
-  desktop <## "1.  (active)"
+  desktop <## "1. Mobile (active)"
+
   mobile ##> "/list remote ctrls"
   mobile <## "Remote controllers:"
   mobile <## "1. My desktop (active)"
 
   stopMobile mobile desktop `catchAny` (logError . tshow)
-  -- TODO: add a case for 'stopDesktop'
 
   desktop ##> "/delete remote host 1"
   desktop <## "ok"
@@ -162,7 +73,28 @@ remoteHandshakeTest = testChat2 aliceProfile bobProfile $ \desktop mobile -> do
   mobile ##> "/list remote ctrls"
   mobile <## "No remote controllers"
 
-remoteMessageTest :: (HasCallStack) => FilePath -> IO ()
+remoteHandshakeStoredTest :: HasCallStack => FilePath -> IO ()
+remoteHandshakeStoredTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
+  logNote "Starting new session"
+  startRemote mobile desktop
+  stopMobile mobile desktop `catchAny` (logError . tshow)
+
+  logNote "Starting stored session"
+  startRemoteStored mobile desktop
+  stopMobile mobile desktop `catchAny` (logError . tshow)
+
+  desktop ##> "/list remote hosts"
+  desktop <## "Remote hosts:"
+  desktop <## "1. Mobile"
+  mobile ##> "/list remote ctrls"
+  mobile <## "Remote controllers:"
+  mobile <## "1. My desktop"
+
+  logNote "Starting stored session again"
+  startRemoteStored mobile desktop
+  stopMobile mobile desktop `catchAny` (logError . tshow)
+
+remoteMessageTest :: HasCallStack => FilePath -> IO ()
 remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
   startRemote mobile desktop
   contactBob desktop bob
@@ -204,11 +136,13 @@ remoteStoreFileTest =
       let bobFiles = "./tests/tmp/bob_files"
       bob ##> ("/_files_folder " <> bobFiles)
       bob <## "ok"
+
       startRemote mobile desktop
       contactBob desktop bob
+
       rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
-      desktopHostStore <- case M.lookup 1 rhs of
-        Just RemoteHostSession {storePath} -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
+      desktopHostStore <- case M.lookup (RHId 1) rhs of
+        Just RHSessionConnected {storePath} -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
         _ -> fail "Host session 1 should be started"
       desktop ##> "/store remote file 1 tests/fixtures/test.pdf"
       desktop <## "file test.pdf stored on remote host 1"
@@ -317,7 +251,7 @@ remoteStoreFileTest =
       r `shouldStartWith` "remote host 1 error"
       r `shouldContain` err
 
-remoteCLIFileTest :: (HasCallStack) => FilePath -> IO ()
+remoteCLIFileTest :: HasCallStack => FilePath -> IO ()
 remoteCLIFileTest = testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> withXFTPServer $ do
   createDirectoryIfMissing True "./tests/tmp/tmp/"
   let mobileFiles = "./tests/tmp/mobile_files"
@@ -333,8 +267,8 @@ remoteCLIFileTest = testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile
   contactBob desktop bob
 
   rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
-  desktopHostStore <- case M.lookup 1 rhs of
-    Just RemoteHostSession {storePath} -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
+  desktopHostStore <- case M.lookup (RHId 1) rhs of
+    Just RHSessionConnected {storePath} -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
     _ -> fail "Host session 1 should be started"
 
   mobileName <- userName mobile
@@ -395,41 +329,41 @@ startRemote :: TestCC -> TestCC -> IO ()
 startRemote mobile desktop = do
   desktop ##> "/set device name My desktop"
   desktop <## "ok"
-  desktop ##> "/create remote host"
-  desktop <## "remote host 1 created"
-  -- A new host is started [automatically] by UI
-  desktop ##> "/start remote host 1"
-  desktop <## "ok"
-  desktop <## "remote host 1 started"
-  desktop <## "connection code:"
-  oobLink <- getTermLine desktop
-  OOB {caFingerprint = oobFingerprint} <- either (fail . mappend "OOB link failed: ") pure $ decodeOOBLink (fromString oobLink)
-  -- Desktop displays OOB QR code
-
   mobile ##> "/set device name Mobile"
   mobile <## "ok"
-  mobile ##> "/find remote ctrl"
+  desktop ##> "/start remote host new"
+  desktop <## "new remote host started"
+  desktop <## "Remote session invitation:"
+  inv <- getTermLine desktop
+  mobile ##> ("/connect remote ctrl " <> inv)
   mobile <## "ok"
-  mobile <## "remote controller announced"
-  mobile <## "connection code:"
-  annFingerprint <- getTermLine mobile
-  -- The user scans OOB QR code and confirms it matches the announced stuff
-  fromString annFingerprint `shouldBe` strEncode oobFingerprint
-
-  mobile ##> ("/connect remote ctrl " <> oobLink)
-  mobile <## "remote controller 1 registered"
-  mobile ##> "/confirm remote ctrl 1"
-  mobile <## "ok"
-  mobile <## "remote controller 1 connecting to My desktop"
-  -- TODO: rework tls connection prelude
-  mobile <## "remote controller 1 connected to My desktop"
+  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:"
-  verifyCmd <- getTermLine mobile
-  mobile ##> verifyCmd
+  mobile <## ("/verify remote ctrl " <> sessId)
+  mobile ##> ("/verify remote ctrl " <> sessId)
+  mobile <## "remote controller 1 session started with My desktop"
+  desktop <## "remote host 1 connected"
+
+startRemoteStored :: TestCC -> TestCC -> IO ()
+startRemoteStored mobile desktop = do
+  desktop ##> "/start remote host 1"
+  desktop <## "remote host 1 started"
+  desktop <## "Remote session invitation:"
+  inv <- getTermLine desktop
+  mobile ##> ("/connect remote ctrl " <> inv)
   mobile <## "ok"
-  concurrently_
-    (mobile <## "remote controller 1 session started with My desktop")
-    (desktop <## "remote host 1 connected")
+  desktop <## "remote host 1 connecting"
+  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
@@ -453,9 +387,12 @@ stopDesktop mobile desktop = do
   logWarn "stopping via desktop"
   desktop ##> "/stop remote host 1"
   -- desktop <## "ok"
-  concurrently_
-    (desktop <## "remote host 1 stopped")
-    (eventually 3 $ mobile <## "remote controller stopped")
+  concurrentlyN_
+    [ do
+        desktop <## "remote host 1 stopped"
+        desktop <## "ok",
+      eventually 3 $ mobile <## "remote controller stopped"
+    ]
 
 stopMobile :: HasCallStack => TestCC -> TestCC -> IO ()
 stopMobile mobile desktop = do
@@ -468,7 +405,9 @@ stopMobile mobile desktop = do
 
 -- | Run action with extended timeout
 eventually :: Int -> IO a -> IO a
-eventually retries action = tryAny action >>= \case -- TODO: only catch timeouts
-  Left err | retries == 0 -> throwIO err
-  Left _ -> eventually (retries - 1) action
-  Right r -> pure r
+eventually retries action =
+  tryAny action >>= \case
+    -- TODO: only catch timeouts
+    Left err | retries == 0 -> throwIO err
+    Left _ -> eventually (retries - 1) action
+    Right r -> pure r

From 3dd62ab05a365d973bb4c2c13b46994028db37c1 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 9 Nov 2023 09:37:56 +0000
Subject: [PATCH 31/69] core: remove Hello from the app remote protocol (#3336)

---
 src/Simplex/Chat/Remote.hs          | 25 +++++++++------------
 src/Simplex/Chat/Remote/Protocol.hs | 35 +++++++++++------------------
 2 files changed, 23 insertions(+), 37 deletions(-)

diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 8bb354c21..6ff470cca 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -141,18 +141,21 @@ startRemoteHost' rh_ = do
     mkCtrlAppInfo = do
       deviceName <- chatReadVar localDeviceName
       pure CtrlAppInfo {appVersionRange = ctrlAppVersionRange, deviceName}
-    parseHostAppInfo RCHostHello {app = hostAppInfo} rhKey = do
-      HostAppInfo {deviceName, appVersion} <-
-        liftEitherWith (ChatErrorRemoteHost rhKey . RHEProtocolError . RPEInvalidJSON) $ JT.parseEither J.parseJSON hostAppInfo
-      unless (isAppCompatible appVersion ctrlAppVersionRange) $ throwError $ ChatErrorRemoteHost rhKey $ RHEBadVersion appVersion
-      pure deviceName
+    parseHostAppInfo :: RCHostHello -> ExceptT RemoteHostError IO HostAppInfo
+    parseHostAppInfo RCHostHello {app = hostAppInfo} = do
+      hostInfo@HostAppInfo {deviceName, appVersion, encoding, encryptFiles} <-
+        liftEitherWith (RHEProtocolError . RPEInvalidJSON) $ JT.parseEither J.parseJSON hostAppInfo
+      unless (isAppCompatible appVersion ctrlAppVersionRange) $ throwError $ RHEBadVersion appVersion
+      when (encoding == PEKotlin && localEncoding == PESwift) $ throwError $ RHEProtocolError RPEIncompatibleEncoding
+      pure hostInfo
     waitForSession :: ChatMonad m => RHKey -> Maybe RemoteHostInfo -> RCHostClient -> RCStepTMVar (ByteString, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
     waitForSession rhKey remoteHost_ _rchClient_kill_on_error vars = do
       -- TODO handle errors
       (sessId, vars') <- takeRCStep vars
       toView $ CRRemoteHostSessionCode {remoteHost_, sessionCode = verificationCode sessId} -- display confirmation code, wait for mobile to confirm
       (RCHostSession {tls, sessionKeys}, rhHello, pairing') <- takeRCStep vars'
-      hostDeviceName <- parseHostAppInfo rhHello rhKey
+      hostInfo@HostAppInfo {deviceName = hostDeviceName} <-
+        liftError (ChatErrorRemoteHost rhKey) $ parseHostAppInfo rhHello
       withRemoteHostSession rhKey $ \case
         RHSessionConnecting rhs' -> Right ((), RHSessionConfirmed rhs') -- TODO check it's the same session?
         _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState -- TODO kill client on error
@@ -161,7 +164,7 @@ startRemoteHost' rh_ = do
       let rhKey' = RHId remoteHostId
       disconnected <- toIO $ onDisconnected remoteHostId
       httpClient <- liftEitherError (httpError rhKey) $ attachRevHTTP2Client disconnected tls
-      rhClient <- liftRC $ createRemoteHostClient httpClient sessionKeys storePath hostDeviceName
+      let rhClient = mkRemoteHostClient httpClient sessionKeys storePath hostInfo
       pollAction <- async $ pollEvents remoteHostId rhClient
       withRemoteHostSession rhKey' $ \case
         RHSessionConfirmed RHPendingSession {} -> Right ((), RHSessionConnected {rhClient, pollAction, storePath})
@@ -346,7 +349,6 @@ handleRemoteCommand execChatCommand _sessionKeys remoteOutputQ HTTP2Request {req
     replyError = reply . RRChatResponse . CRChatCmdError Nothing
     processCommand :: User -> GetChunk -> RemoteCommand -> m ()
     processCommand user getNext = \case
-      RCHello {deviceName = desktopName} -> handleHello desktopName >>= reply
       RCSend {command} -> handleSend execChatCommand command >>= reply
       RCRecv {wait = time} -> handleRecv time remoteOutputQ >>= reply
       RCStoreFile {fileName, fileSize, fileDigest} -> handleStoreFile fileName fileSize fileDigest getNext >>= reply
@@ -376,13 +378,6 @@ tryRemoteError :: ExceptT RemoteProtocolError IO a -> ExceptT RemoteProtocolErro
 tryRemoteError = tryAllErrors (RPEException . tshow)
 {-# INLINE tryRemoteError #-}
 
-handleHello :: ChatMonad m => Text -> m RemoteResponse
-handleHello desktopName = do
-  logInfo $ "Hello from " <> tshow desktopName
-  mobileName <- chatReadVar localDeviceName
-  encryptFiles <- chatReadVar encryptLocalFiles
-  pure RRHello {encoding = localEncoding, deviceName = mobileName, encryptFiles}
-
 handleSend :: ChatMonad m => (ByteString -> m ChatResponse) -> Text -> m RemoteResponse
 handleSend execChatCommand command = do
   logDebug $ "Send: " <> tshow command
diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs
index 2868a4510..62db487cb 100644
--- a/src/Simplex/Chat/Remote/Protocol.hs
+++ b/src/Simplex/Chat/Remote/Protocol.hs
@@ -9,7 +9,6 @@
 
 module Simplex.Chat.Remote.Protocol where
 
-import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Data.Aeson ((.=))
@@ -44,8 +43,7 @@ import System.FilePath (takeFileName, (</>))
 import UnliftIO
 
 data RemoteCommand
-  = RCHello {deviceName :: Text}
-  | RCSend {command :: Text} -- TODO maybe ChatCommand here?
+  = RCSend {command :: Text} -- TODO maybe ChatCommand here?
   | RCRecv {wait :: Int} -- this wait should be less than HTTP timeout
   | -- local file encryption is determined by the host, but can be overridden for videos
     RCStoreFile {fileName :: String, fileSize :: Word32, fileDigest :: FileDigest} -- requires attachment
@@ -53,8 +51,7 @@ data RemoteCommand
   deriving (Show)
 
 data RemoteResponse
-  = RRHello {encoding :: PlatformEncoding, deviceName :: Text, encryptFiles :: Bool}
-  | RRChatResponse {chatResponse :: ChatResponse}
+  = RRChatResponse {chatResponse :: ChatResponse}
   | RRChatEvent {chatEvent :: Maybe ChatResponse} -- ^ 'Nothing' on poll timeout
   | RRFileStored {filePath :: String}
   | RRFile {fileSize :: Word32, fileDigest :: FileDigest} -- provides attachment , fileDigest :: FileDigest
@@ -67,22 +64,16 @@ $(deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse)
 
 -- * Client side / desktop
 
-createRemoteHostClient :: HTTP2Client -> HostSessKeys -> FilePath -> Text -> ExceptT RemoteProtocolError IO RemoteHostClient
-createRemoteHostClient httpClient sessionKeys storePath desktopName = do
-  logDebug "Sending initial hello"
-  sendRemoteCommand' httpClient localEncoding Nothing RCHello {deviceName = desktopName} >>= \case
-    RRHello {encoding, deviceName = mobileName, encryptFiles} -> do
-      logDebug "Got initial hello"
-      when (encoding == PEKotlin && localEncoding == PESwift) $ throwError RPEIncompatibleEncoding
-      pure RemoteHostClient
-        { hostEncoding = encoding,
-          hostDeviceName = mobileName,
-          httpClient,
-          encryptHostFiles = encryptFiles,
-          sessionKeys,
-          storePath
-        }
-    r -> badResponse r
+mkRemoteHostClient :: HTTP2Client -> HostSessKeys -> FilePath -> HostAppInfo -> RemoteHostClient
+mkRemoteHostClient httpClient sessionKeys storePath HostAppInfo {encoding, deviceName, encryptFiles} =
+  RemoteHostClient
+    { hostEncoding = encoding,
+      hostDeviceName = deviceName,
+      httpClient,
+      encryptHostFiles = encryptFiles,
+      sessionKeys,
+      storePath
+    }
 
 closeRemoteHostClient :: MonadIO m => RemoteHostClient -> m ()
 closeRemoteHostClient RemoteHostClient {httpClient} = liftIO $ closeHTTP2Client httpClient
@@ -148,7 +139,7 @@ convertJSON :: PlatformEncoding -> PlatformEncoding -> J.Value -> J.Value
 convertJSON _remote@PEKotlin _local@PEKotlin = id
 convertJSON PESwift PESwift = id
 convertJSON PESwift PEKotlin = owsf2tagged
-convertJSON PEKotlin PESwift = error "unsupported convertJSON: K/S" -- guarded by createRemoteHostClient
+convertJSON PEKotlin PESwift = error "unsupported convertJSON: K/S" -- guarded by handshake
 
 -- | Convert swift single-field sum encoding into tagged/discriminator-field
 owsf2tagged :: J.Value -> J.Value

From 6d4febb669e0b86a8facb164b7b1daa4bcef9736 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Thu, 9 Nov 2023 20:25:05 +0200
Subject: [PATCH 32/69] core: handle remote control session setup errors
 (#3332)

* handle session setup errors

* add command/async wrapper

* move furniture around
---
 src/Simplex/Chat/Remote.hs | 92 +++++++++++++++++++++++++-------------
 1 file changed, 62 insertions(+), 30 deletions(-)

diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 6ff470cca..8dcf0de89 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -131,26 +131,38 @@ startRemoteHost' rh_ = do
   withRemoteHostSession_ rhKey $ maybe (Right ((), Just RHSessionStarting)) (\_ -> Left $ ChatErrorRemoteHost rhKey RHEBusy)
   ctrlAppInfo <- mkCtrlAppInfo
   (invitation, rchClient, vars) <- withAgent $ \a -> rcConnectHost a pairing (J.toJSON ctrlAppInfo) multicast
-  rhsWaitSession <- async $ waitForSession rhKey remoteHost_ rchClient vars
+  cmdOk <- newEmptyTMVarIO
+  rhsWaitSession <- async $ do
+    atomically $ takeTMVar cmdOk
+    cleanupOnError rchClient $ waitForSession remoteHost_ vars
   let rhs = RHPendingSession {rhKey, rchClient, rhsWaitSession, remoteHost_}
   withRemoteHostSession rhKey $ \case
     RHSessionStarting -> Right ((), RHSessionConnecting rhs)
     _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
-  pure (remoteHost_, invitation)
+  (remoteHost_, invitation) <$ atomically (putTMVar cmdOk ())
   where
     mkCtrlAppInfo = do
       deviceName <- chatReadVar localDeviceName
       pure CtrlAppInfo {appVersionRange = ctrlAppVersionRange, deviceName}
     parseHostAppInfo :: RCHostHello -> ExceptT RemoteHostError IO HostAppInfo
     parseHostAppInfo RCHostHello {app = hostAppInfo} = do
-      hostInfo@HostAppInfo {deviceName, appVersion, encoding, encryptFiles} <-
+      hostInfo@HostAppInfo {appVersion, encoding} <-
         liftEitherWith (RHEProtocolError . RPEInvalidJSON) $ JT.parseEither J.parseJSON hostAppInfo
       unless (isAppCompatible appVersion ctrlAppVersionRange) $ throwError $ RHEBadVersion appVersion
       when (encoding == PEKotlin && localEncoding == PESwift) $ throwError $ RHEProtocolError RPEIncompatibleEncoding
       pure hostInfo
-    waitForSession :: ChatMonad m => RHKey -> Maybe RemoteHostInfo -> RCHostClient -> RCStepTMVar (ByteString, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
-    waitForSession rhKey remoteHost_ _rchClient_kill_on_error vars = do
-      -- TODO handle errors
+    cleanupOnError :: ChatMonad m => RCHostClient -> (TMVar RHKey -> m ()) -> m ()
+    cleanupOnError rchClient action = do
+      currentKey <- newEmptyTMVarIO
+      action currentKey `catchChatError` \err -> do
+        logError $ "startRemoteHost'.waitForSession crashed: " <> tshow err
+        sessions <- asks remoteHostSessions
+        atomically $ readTMVar currentKey >>= (`TM.delete` sessions)
+        liftIO $ cancelHostClient rchClient
+    waitForSession :: ChatMonad m => Maybe RemoteHostInfo -> RCStepTMVar (ByteString, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> TMVar RHKey -> m ()
+    waitForSession remoteHost_ vars currentKey = do
+      let rhKey = maybe RHNew (\RemoteHostInfo {remoteHostId} -> RHId remoteHostId) remoteHost_
+      atomically $ writeTMVar currentKey rhKey
       (sessId, vars') <- takeRCStep vars
       toView $ CRRemoteHostSessionCode {remoteHost_, sessionCode = verificationCode sessId} -- display confirmation code, wait for mobile to confirm
       (RCHostSession {tls, sessionKeys}, rhHello, pairing') <- takeRCStep vars'
@@ -158,23 +170,24 @@ startRemoteHost' rh_ = do
         liftError (ChatErrorRemoteHost rhKey) $ parseHostAppInfo rhHello
       withRemoteHostSession rhKey $ \case
         RHSessionConnecting rhs' -> Right ((), RHSessionConfirmed rhs') -- TODO check it's the same session?
-        _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState -- TODO kill client on error
+        _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
       -- update remoteHost with updated pairing
       rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' remoteHost_ hostDeviceName
-      let rhKey' = RHId remoteHostId
+      let rhKey' = RHId remoteHostId -- rhKey may be invalid after upserting on RHNew
+      atomically $ writeTMVar currentKey rhKey'
       disconnected <- toIO $ onDisconnected remoteHostId
-      httpClient <- liftEitherError (httpError rhKey) $ attachRevHTTP2Client disconnected tls
+      httpClient <- liftEitherError (httpError rhKey') $ attachRevHTTP2Client disconnected tls
       let rhClient = mkRemoteHostClient httpClient sessionKeys storePath hostInfo
       pollAction <- async $ pollEvents remoteHostId rhClient
       withRemoteHostSession rhKey' $ \case
         RHSessionConfirmed RHPendingSession {} -> Right ((), RHSessionConnected {rhClient, pollAction, storePath})
-        _ -> Left $ ChatErrorRemoteHost rhKey' RHEBadState -- TODO kill client on error
+        _ -> Left $ ChatErrorRemoteHost rhKey' RHEBadState
       chatWriteVar currentRemoteHost $ Just remoteHostId -- this is required for commands to be passed to remote host
       toView $ CRRemoteHostConnected rhi
     upsertRemoteHost :: ChatMonad m => RCHostPairing -> Maybe RemoteHostInfo -> Text -> m RemoteHostInfo
-    upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rh_ hostDeviceName = do
+    upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rhi_ hostDeviceName = do
       KnownHostPairing {hostDhPubKey = hostDhPubKey'} <- maybe (throwError . ChatError $ CEInternalError "KnownHost is known after verification") pure kh_
-      case rh_ of
+      case rhi_ of
         Nothing -> do
           storePath <- liftIO randomStorePath
           rh@RemoteHost {remoteHostId} <- withStore $ \db -> insertRemoteHost db hostDeviceName storePath pairing' >>= getRemoteHost db
@@ -307,11 +320,20 @@ connectRemoteCtrl inv@RCSignedInvitation {invitation = RCInvitation {ca, app}} =
   rc_ <- withStore' $ \db -> getRemoteCtrlByFingerprint db ca
   hostAppInfo <- getHostAppInfo v
   (rcsClient, vars) <- withAgent $ \a -> rcConnectCtrlURI a inv (ctrlPairing <$> rc_) (J.toJSON hostAppInfo)
-  rcsWaitSession <- async $ waitForSession rc_ ctrlDeviceName rcsClient vars
-  updateRemoteCtrlSession $ \case
+  cmdOk <- newEmptyTMVarIO
+  rcsWaitSession <- async $ do
+    atomically $ takeTMVar cmdOk
+    cleanupOnError rcsClient $ waitForSession rc_ ctrlDeviceName rcsClient vars
+  cleanupOnError rcsClient . updateRemoteCtrlSession $ \case
     RCSessionStarting -> Right RCSessionConnecting {rcsClient, rcsWaitSession}
-    _ -> Left $ ChatErrorRemoteCtrl RCEBadState -- TODO kill rcsClient
+    _ -> Left $ ChatErrorRemoteCtrl RCEBadState
+  atomically $ putTMVar cmdOk ()
   where
+    cleanupOnError :: ChatMonad m => RCCtrlClient -> m () -> m ()
+    cleanupOnError rcsClient action = action `catchChatError` \e -> do
+      logError $ "connectRemoteCtrl crashed with: " <> tshow e
+      chatWriteVar remoteCtrlSession Nothing -- XXX: can only wipe PendingConfirmation or RCSessionConnecting, which only have rcsClient to cancel
+      liftIO $ cancelCtrlClient rcsClient
     waitForSession :: ChatMonad m => Maybe RemoteCtrl -> Text -> RCCtrlClient -> RCStepTMVar (ByteString, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> m ()
     waitForSession rc_ ctrlName rcsClient vars = do
       (uniq, rcsWaitConfirmation) <- takeRCStep vars
@@ -319,7 +341,7 @@ connectRemoteCtrl inv@RCSignedInvitation {invitation = RCInvitation {ca, app}} =
       toView CRRemoteCtrlSessionCode {remoteCtrl_ = (`remoteCtrlInfo` True) <$> rc_, sessionCode}
       updateRemoteCtrlSession $ \case
         RCSessionConnecting {rcsWaitSession} -> Right RCSessionPendingConfirmation {ctrlName, rcsClient, sessionCode, rcsWaitSession, rcsWaitConfirmation}
-        _ -> Left $ ChatErrorRemoteCtrl RCEBadState -- TODO kill rcsClient
+        _ -> Left $ ChatErrorRemoteCtrl RCEBadState
     parseCtrlAppInfo ctrlAppInfo = do
       CtrlAppInfo {deviceName, appVersionRange} <-
         liftEitherWith (const $ ChatErrorRemoteCtrl RCEBadInvitation) $ JT.parseEither J.parseJSON ctrlAppInfo
@@ -449,7 +471,7 @@ confirmRemoteCtrl _rcId = do
 
 -- | 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' = do
+verifyRemoteCtrlSession execChatCommand sessCode' = cleanupOnError $ do
   (client, ctrlName, sessionCode, vars) <-
     getRemoteCtrlSession >>= \case
       RCSessionPendingConfirmation {rcsClient, ctrlName, sessionCode, rcsWaitConfirmation} -> pure (rcsClient, ctrlName, sessionCode, rcsWaitConfirmation)
@@ -458,25 +480,35 @@ verifyRemoteCtrlSession execChatCommand sessCode' = do
   liftIO $ confirmCtrlSession client verified
   unless verified $ throwError $ ChatErrorRemoteCtrl RCEBadVerificationCode
   (rcsSession@RCCtrlSession {tls, sessionKeys}, rcCtrlPairing) <- takeRCStep vars
-  rc@RemoteCtrl {remoteCtrlId} <- withStore $ \db -> do
-    rc_ <- liftIO $ getRemoteCtrlByFingerprint db (ctrlFingerprint rcCtrlPairing)
-    case rc_ of
-      Nothing -> insertRemoteCtrl db ctrlName rcCtrlPairing >>= getRemoteCtrl db
-      Just rc@RemoteCtrl {remoteCtrlId} -> do
-        liftIO $ updateCtrlPairingKeys db remoteCtrlId (dhPrivKey rcCtrlPairing)
-        pure rc
+  rc@RemoteCtrl {remoteCtrlId} <- upsertRemoteCtrl ctrlName rcCtrlPairing
   remoteOutputQ <- asks (tbqSize . config) >>= newTBQueueIO
   http2Server <- async $ attachHTTP2Server tls $ handleRemoteCommand execChatCommand sessionKeys remoteOutputQ
+  void . forkIO $ monitor http2Server
   withRemoteCtrlSession $ \case
     RCSessionPendingConfirmation {} -> Right ((), RCSessionConnected {remoteCtrlId, rcsClient = client, rcsSession, http2Server, remoteOutputQ})
     _ -> Left $ ChatErrorRemoteCtrl RCEBadState
-  void . forkIO $ do
-    waitCatch http2Server >>= \case
-      Left err | Just (BadThingHappen innerErr) <- fromException err -> logWarn $ "HTTP2 server crashed with internal " <> tshow innerErr
-      Left err | isNothing (fromException @AsyncCancelled err) -> logError $ "HTTP2 server crashed with " <> tshow err
-      _ -> logInfo "HTTP2 server stopped"
-    toView CRRemoteCtrlStopped
   pure $ remoteCtrlInfo rc True
+  where
+    upsertRemoteCtrl :: ChatMonad m => Text -> RCCtrlPairing -> m RemoteCtrl
+    upsertRemoteCtrl ctrlName rcCtrlPairing = withStore $ \db -> do
+      rc_ <- liftIO $ getRemoteCtrlByFingerprint db (ctrlFingerprint rcCtrlPairing)
+      case rc_ of
+        Nothing -> insertRemoteCtrl db ctrlName rcCtrlPairing >>= getRemoteCtrl db
+        Just rc@RemoteCtrl {remoteCtrlId} -> do
+          liftIO $ updateCtrlPairingKeys db remoteCtrlId (dhPrivKey rcCtrlPairing)
+          pure rc
+    cleanupOnError :: ChatMonad m => m a -> m a
+    cleanupOnError action = action `catchChatError` \e -> do
+      logError $ "verifyRemoteCtrlSession crashed with: " <> tshow e
+      withRemoteCtrlSession_ (\s -> pure (s, Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl) -- cancel session threads, if any
+      throwError e
+    monitor :: ChatMonad m => Async a -> m ()
+    monitor server = do
+      waitCatch server >>= \case
+        Left err | Just (BadThingHappen innerErr) <- fromException err -> logWarn $ "HTTP2 server crashed with internal " <> tshow innerErr
+        Left err | isNothing (fromException @AsyncCancelled err) -> logError $ "HTTP2 server crashed with " <> tshow err
+        _ -> logInfo "HTTP2 server stopped"
+      toView CRRemoteCtrlStopped
 
 stopRemoteCtrl :: ChatMonad m => m ()
 stopRemoteCtrl =

From f41861c026bf1f8de873d497b8ce6e74f41aa539 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Fri, 10 Nov 2023 00:43:44 +0200
Subject: [PATCH 33/69] core: terminate remote control TLS connection on both
 sides (#3338)

* handle session setup errors

* add command/async wrapper

* move furniture around

* detect disconnects and force them with closeConnection

* simplify http server log

* close TLS in other cases

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 cabal.project                    |  2 +-
 scripts/nix/sha256map.nix        |  2 +-
 src/Simplex/Chat/Controller.hs   | 12 ++++++----
 src/Simplex/Chat/Remote.hs       | 39 ++++++++++++++++++--------------
 src/Simplex/Chat/Remote/Types.hs |  5 ++--
 stack.yaml                       |  2 +-
 tests/RemoteTests.hs             | 22 ++++++++++--------
 7 files changed, 47 insertions(+), 37 deletions(-)

diff --git a/cabal.project b/cabal.project
index fe74d2148..ea6129f3f 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: 102487bc4fbb865aac4207d2ba6f2ea77eff3290
+    tag: bd06b47a9df13506ee77251868a5a1d1e7cadafe
 
 source-repository-package
     type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 26f7357a1..d9033088a 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."102487bc4fbb865aac4207d2ba6f2ea77eff3290" = "1zay63ix9vh20p6843l1zry47zwb7lkirmxrrgdcc7qwl89js1bs";
+  "https://github.com/simplex-chat/simplexmq.git"."bd06b47a9df13506ee77251868a5a1d1e7cadafe" = "1x6hy3awxf10l5ai82p3fhsrv1flc24gxsw9jl1b0cl7iypxhmsp";
   "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/Controller.hs b/src/Simplex/Chat/Controller.hs
index 4c38ca95d..6832bb562 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -16,7 +16,6 @@
 
 module Simplex.Chat.Controller where
 
-import Simplex.RemoteControl.Invitation (RCSignedInvitation)
 import Control.Concurrent (ThreadId)
 import Control.Concurrent.Async (Async)
 import Control.Exception
@@ -29,6 +28,7 @@ import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as JQ
 import qualified Data.Aeson.Types as JT
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (ord)
@@ -70,16 +70,16 @@ import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
 import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, MsgFlags, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServerWithAuth, userProtocol)
 import Simplex.Messaging.TMap (TMap)
-import Simplex.Messaging.Transport (simplexMQVersion)
+import Simplex.Messaging.Transport (TLS, simplexMQVersion)
 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.Types
 import System.IO (Handle)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
-import Data.Bifunctor (first)
-import Simplex.RemoteControl.Client
-import Simplex.RemoteControl.Types
 
 versionNumber :: String
 versionNumber = showVersion SC.version
@@ -1086,6 +1086,7 @@ data RemoteCtrlSession
   | RCSessionPendingConfirmation
       { ctrlName :: Text,
         rcsClient :: RCCtrlClient,
+        tls :: TLS,
         sessionCode :: Text,
         rcsWaitSession :: Async (),
         rcsWaitConfirmation :: TMVar (Either RCErrorType (RCCtrlSession, RCCtrlPairing))
@@ -1093,6 +1094,7 @@ data RemoteCtrlSession
   | RCSessionConnected
       { remoteCtrlId :: RemoteCtrlId,
         rcsClient :: RCCtrlClient,
+        tls :: TLS,
         rcsSession :: RCCtrlSession,
         http2Server :: Async (),
         remoteOutputQ :: TBQueue ChatResponse
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 8dcf0de89..a5ddc3439 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -60,6 +60,7 @@ 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)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2ClientError, closeHTTP2Client)
 import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
@@ -169,7 +170,7 @@ startRemoteHost' rh_ = do
       hostInfo@HostAppInfo {deviceName = hostDeviceName} <-
         liftError (ChatErrorRemoteHost rhKey) $ parseHostAppInfo rhHello
       withRemoteHostSession rhKey $ \case
-        RHSessionConnecting rhs' -> Right ((), RHSessionConfirmed rhs') -- TODO check it's the same session?
+        RHSessionConnecting rhs' -> Right ((), RHSessionConfirmed tls rhs') -- TODO check it's the same session?
         _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
       -- update remoteHost with updated pairing
       rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' remoteHost_ hostDeviceName
@@ -180,7 +181,7 @@ startRemoteHost' rh_ = do
       let rhClient = mkRemoteHostClient httpClient sessionKeys storePath hostInfo
       pollAction <- async $ pollEvents remoteHostId rhClient
       withRemoteHostSession rhKey' $ \case
-        RHSessionConfirmed RHPendingSession {} -> Right ((), RHSessionConnected {rhClient, pollAction, storePath})
+        RHSessionConfirmed _ RHPendingSession {} -> Right ((), RHSessionConnected {tls, rhClient, pollAction, storePath})
         _ -> Left $ ChatErrorRemoteHost rhKey' RHEBadState
       chatWriteVar currentRemoteHost $ Just remoteHostId -- this is required for commands to be passed to remote host
       toView $ CRRemoteHostConnected rhi
@@ -223,14 +224,17 @@ cancelRemoteHost :: RemoteHostSession -> IO ()
 cancelRemoteHost = \case
   RHSessionStarting -> pure ()
   RHSessionConnecting rhs -> cancelPendingSession rhs
-  RHSessionConfirmed rhs -> cancelPendingSession rhs
-  RHSessionConnected {rhClient = RemoteHostClient {httpClient}, pollAction} -> do
+  RHSessionConfirmed tls rhs -> do
+    cancelPendingSession rhs
+    closeConnection tls
+  RHSessionConnected {tls, rhClient = RemoteHostClient {httpClient}, pollAction} -> do
     uninterruptibleCancel pollAction
     closeHTTP2Client httpClient
+    closeConnection tls
   where
     cancelPendingSession RHPendingSession {rchClient, rhsWaitSession} = do
-      cancelHostClient rchClient
       uninterruptibleCancel rhsWaitSession
+      cancelHostClient rchClient
 
 -- | Generate a random 16-char filepath without / in it by using base64url encoding.
 randomStorePath :: IO FilePath
@@ -334,13 +338,13 @@ connectRemoteCtrl inv@RCSignedInvitation {invitation = RCInvitation {ca, app}} =
       logError $ "connectRemoteCtrl crashed with: " <> tshow e
       chatWriteVar remoteCtrlSession Nothing -- XXX: can only wipe PendingConfirmation or RCSessionConnecting, which only have rcsClient to cancel
       liftIO $ cancelCtrlClient rcsClient
-    waitForSession :: ChatMonad m => Maybe RemoteCtrl -> Text -> RCCtrlClient -> RCStepTMVar (ByteString, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> m ()
+    waitForSession :: ChatMonad m => Maybe RemoteCtrl -> Text -> RCCtrlClient -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> m ()
     waitForSession rc_ ctrlName rcsClient vars = do
-      (uniq, rcsWaitConfirmation) <- takeRCStep vars
+      (uniq, tls, rcsWaitConfirmation) <- takeRCStep vars
       let sessionCode = verificationCode uniq
       toView CRRemoteCtrlSessionCode {remoteCtrl_ = (`remoteCtrlInfo` True) <$> rc_, sessionCode}
       updateRemoteCtrlSession $ \case
-        RCSessionConnecting {rcsWaitSession} -> Right RCSessionPendingConfirmation {ctrlName, rcsClient, sessionCode, rcsWaitSession, rcsWaitConfirmation}
+        RCSessionConnecting {rcsWaitSession} -> Right RCSessionPendingConfirmation {ctrlName, rcsClient, tls, sessionCode, rcsWaitSession, rcsWaitConfirmation}
         _ -> Left $ ChatErrorRemoteCtrl RCEBadState
     parseCtrlAppInfo ctrlAppInfo = do
       CtrlAppInfo {deviceName, appVersionRange} <-
@@ -485,7 +489,7 @@ verifyRemoteCtrlSession execChatCommand sessCode' = cleanupOnError $ do
   http2Server <- async $ attachHTTP2Server tls $ handleRemoteCommand execChatCommand sessionKeys remoteOutputQ
   void . forkIO $ monitor http2Server
   withRemoteCtrlSession $ \case
-    RCSessionPendingConfirmation {} -> Right ((), RCSessionConnected {remoteCtrlId, rcsClient = client, rcsSession, http2Server, remoteOutputQ})
+    RCSessionPendingConfirmation {} -> Right ((), RCSessionConnected {remoteCtrlId, rcsClient = client, rcsSession, tls, http2Server, remoteOutputQ})
     _ -> Left $ ChatErrorRemoteCtrl RCEBadState
   pure $ remoteCtrlInfo rc True
   where
@@ -502,12 +506,11 @@ verifyRemoteCtrlSession execChatCommand sessCode' = cleanupOnError $ do
       logError $ "verifyRemoteCtrlSession crashed with: " <> tshow e
       withRemoteCtrlSession_ (\s -> pure (s, Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl) -- cancel session threads, if any
       throwError e
-    monitor :: ChatMonad m => Async a -> m ()
+    monitor :: ChatMonad m => Async () -> m ()
     monitor server = do
-      waitCatch server >>= \case
-        Left err | Just (BadThingHappen innerErr) <- fromException err -> logWarn $ "HTTP2 server crashed with internal " <> tshow innerErr
-        Left err | isNothing (fromException @AsyncCancelled err) -> logError $ "HTTP2 server crashed with " <> tshow err
-        _ -> logInfo "HTTP2 server stopped"
+      res <- waitCatch server
+      logInfo $ "HTTP2 server stopped: " <> tshow res
+      withRemoteCtrlSession_ (\s -> pure (s, Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl) -- cancel session threads, if any
       toView CRRemoteCtrlStopped
 
 stopRemoteCtrl :: ChatMonad m => m ()
@@ -519,14 +522,16 @@ cancelRemoteCtrl :: RemoteCtrlSession -> IO ()
 cancelRemoteCtrl = \case
   RCSessionStarting -> pure ()
   RCSessionConnecting {rcsClient, rcsWaitSession} -> do
-    cancelCtrlClient rcsClient
     uninterruptibleCancel rcsWaitSession
-  RCSessionPendingConfirmation {rcsClient, rcsWaitSession} -> do
     cancelCtrlClient rcsClient
+  RCSessionPendingConfirmation {rcsClient, tls, rcsWaitSession} -> do
     uninterruptibleCancel rcsWaitSession
-  RCSessionConnected {rcsClient, http2Server} -> do
     cancelCtrlClient rcsClient
+    closeConnection tls
+  RCSessionConnected {rcsClient, tls, http2Server} -> do
     uninterruptibleCancel http2Server
+    cancelCtrlClient rcsClient
+    closeConnection tls
 
 deleteRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
 deleteRemoteCtrl rcId = do
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index d9aa9d50b..638707563 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -20,6 +20,7 @@ import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import Simplex.RemoteControl.Client
 import Simplex.RemoteControl.Types
 import Simplex.Messaging.Crypto.File (CryptoFile)
+import Simplex.Messaging.Transport (TLS)
 
 data RemoteHostClient = RemoteHostClient
   { hostEncoding :: PlatformEncoding,
@@ -40,8 +41,8 @@ data RHPendingSession = RHPendingSession
 data RemoteHostSession
   = RHSessionStarting
   | RHSessionConnecting {rhPendingSession :: RHPendingSession}
-  | RHSessionConfirmed {rhPendingSession :: RHPendingSession}
-  | RHSessionConnected {rhClient :: RemoteHostClient, pollAction :: Async (), storePath :: FilePath}
+  | RHSessionConfirmed {tls :: TLS, rhPendingSession :: RHPendingSession}
+  | RHSessionConnected {tls :: TLS, rhClient :: RemoteHostClient, pollAction :: Async (), storePath :: FilePath}
 
 data RemoteProtocolError
   = -- | size prefix is malformed
diff --git a/stack.yaml b/stack.yaml
index 4c26936c0..c90140963 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: 102487bc4fbb865aac4207d2ba6f2ea77eff3290
+    commit: bd06b47a9df13506ee77251868a5a1d1e7cadafe
   - github: kazu-yamamoto/http2
     commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
   # - ../direct-sqlcipher
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 83f7eeee5..b35e54032 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -34,8 +34,8 @@ import UnliftIO.Directory
 remoteTests :: SpecWith FilePath
 remoteTests = describe "Remote" $ do
   describe "protocol handshake" $ do
-    it "connects with new pairing" remoteHandshakeTest
-    it "connects with new pairing (again)" remoteHandshakeTest -- leaking servers regression check
+    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 "sends messages" remoteMessageTest
   describe "remote files" $ do
@@ -44,8 +44,8 @@ remoteTests = describe "Remote" $ do
 
 -- * Chat commands
 
-remoteHandshakeTest :: HasCallStack => FilePath -> IO ()
-remoteHandshakeTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
+remoteHandshakeTest :: HasCallStack => Bool -> FilePath -> IO ()
+remoteHandshakeTest viaDesktop = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
   desktop ##> "/list remote hosts"
   desktop <## "No remote hosts"
   mobile ##> "/list remote ctrls"
@@ -61,7 +61,7 @@ remoteHandshakeTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile deskt
   mobile <## "Remote controllers:"
   mobile <## "1. My desktop (active)"
 
-  stopMobile mobile desktop `catchAny` (logError . tshow)
+  if viaDesktop then stopDesktop mobile desktop else stopMobile mobile desktop
 
   desktop ##> "/delete remote host 1"
   desktop <## "ok"
@@ -81,7 +81,7 @@ remoteHandshakeStoredTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile
 
   logNote "Starting stored session"
   startRemoteStored mobile desktop
-  stopMobile mobile desktop `catchAny` (logError . tshow)
+  stopDesktop mobile desktop `catchAny` (logError . tshow)
 
   desktop ##> "/list remote hosts"
   desktop <## "Remote hosts:"
@@ -398,10 +398,12 @@ stopMobile :: HasCallStack => TestCC -> TestCC -> IO ()
 stopMobile mobile desktop = do
   logWarn "stopping via mobile"
   mobile ##> "/stop remote ctrl"
-  mobile <## "ok"
-  concurrently_
-    (mobile <## "remote controller stopped")
-    (eventually 3 $ desktop <## "remote host 1 stopped")
+  concurrentlyN_
+    [ do
+        mobile <## "remote controller stopped"
+        mobile <## "ok",
+      eventually 3 $ desktop <## "remote host 1 stopped"
+    ]
 
 -- | Run action with extended timeout
 eventually :: Int -> IO a -> IO a

From 02225df274a2ab332681ebadf87ccbf28396c845 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Fri, 10 Nov 2023 16:10:10 +0000
Subject: [PATCH 34/69] core: remote control command/response encryption and
 signing inside TLS (#3339)

* core: remote control command/response encryption inside TLS (except files, no signing)

* sign/verify

* update simplexmq

* fix lazy

* remove RSNone
---
 cabal.project                       |   2 +-
 scripts/nix/sha256map.nix           |   2 +-
 src/Simplex/Chat/Remote.hs          |  22 ++--
 src/Simplex/Chat/Remote/Protocol.hs | 188 +++++++++++++++++++++-------
 src/Simplex/Chat/Remote/Types.hs    |  28 ++++-
 stack.yaml                          |   2 +-
 6 files changed, 187 insertions(+), 57 deletions(-)

diff --git a/cabal.project b/cabal.project
index ea6129f3f..8255bb793 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: bd06b47a9df13506ee77251868a5a1d1e7cadafe
+    tag: 6a2e6b040ec8566de2f4cf97bae6700a6a5cbeda
 
 source-repository-package
     type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index d9033088a..26d4dbbea 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."bd06b47a9df13506ee77251868a5a1d1e7cadafe" = "1x6hy3awxf10l5ai82p3fhsrv1flc24gxsw9jl1b0cl7iypxhmsp";
+  "https://github.com/simplex-chat/simplexmq.git"."6a2e6b040ec8566de2f4cf97bae6700a6a5cbeda" = "0diwdkwxxrly01ag7aygaa86ycwz13q2majvn48yg495zvqkrp7n";
   "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/Remote.hs b/src/Simplex/Chat/Remote.hs
index a5ddc3439..53b63d72b 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -60,7 +60,7 @@ 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)
+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.File (hSendFile)
@@ -178,7 +178,7 @@ startRemoteHost' rh_ = do
       atomically $ writeTMVar currentKey rhKey'
       disconnected <- toIO $ onDisconnected remoteHostId
       httpClient <- liftEitherError (httpError rhKey') $ attachRevHTTP2Client disconnected tls
-      let rhClient = mkRemoteHostClient httpClient sessionKeys storePath hostInfo
+      rhClient <- mkRemoteHostClient httpClient sessionKeys sessId storePath hostInfo
       pollAction <- async $ pollEvents remoteHostId rhClient
       withRemoteHostSession rhKey' $ \case
         RHSessionConfirmed _ RHPendingSession {} -> Right ((), RHSessionConnected {tls, rhClient, pollAction, storePath})
@@ -358,8 +358,8 @@ connectRemoteCtrl inv@RCSignedInvitation {invitation = RCInvitation {ca, app}} =
       encryptFiles <- chatReadVar encryptLocalFiles
       pure HostAppInfo {appVersion, deviceName = hostDeviceName, encoding = localEncoding, encryptFiles}
 
-handleRemoteCommand :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> CtrlSessKeys -> TBQueue ChatResponse -> HTTP2Request -> m ()
-handleRemoteCommand execChatCommand _sessionKeys remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
+handleRemoteCommand :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> RemoteCrypto -> TBQueue ChatResponse -> HTTP2Request -> m ()
+handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
   logDebug "handleRemoteCommand"
   liftRC (tryRemoteError parseRequest) >>= \case
     Right (getNext, rc) -> do
@@ -370,8 +370,8 @@ handleRemoteCommand execChatCommand _sessionKeys remoteOutputQ HTTP2Request {req
   where
     parseRequest :: ExceptT RemoteProtocolError IO (GetChunk, RemoteCommand)
     parseRequest = do
-      (header, getNext) <- parseHTTP2Body request reqBody
-      (getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecodeStrict' header)
+      (header, getNext) <- parseDecryptHTTP2Body encryption request reqBody
+      (getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecode header)
     replyError = reply . RRChatResponse . CRChatCmdError Nothing
     processCommand :: User -> GetChunk -> RemoteCommand -> m ()
     processCommand user getNext = \case
@@ -382,9 +382,10 @@ handleRemoteCommand execChatCommand _sessionKeys remoteOutputQ HTTP2Request {req
     reply :: RemoteResponse -> m ()
     reply = (`replyWith` \_ -> pure ())
     replyWith :: Respond m
-    replyWith rr attach =
+    replyWith rr attach = do
+      resp <- liftRC $ encryptEncodeHTTP2Body encryption $ J.encode rr
       liftIO . sendResponse . responseStreaming N.status200 [] $ \send flush -> do
-        send $ sizePrefixedEncode rr
+        send resp
         attach send
         flush
 
@@ -482,11 +483,12 @@ verifyRemoteCtrlSession execChatCommand sessCode' = cleanupOnError $ do
       _ -> throwError $ ChatErrorRemoteCtrl RCEBadState
   let verified = sameVerificationCode sessCode' sessionCode
   liftIO $ confirmCtrlSession client verified
-  unless verified $ throwError $ ChatErrorRemoteCtrl RCEBadVerificationCode
+  unless verified $ throwError $ ChatErrorRemoteCtrl $ RCEProtocolError PRESessionCode
   (rcsSession@RCCtrlSession {tls, sessionKeys}, rcCtrlPairing) <- takeRCStep vars
   rc@RemoteCtrl {remoteCtrlId} <- upsertRemoteCtrl ctrlName rcCtrlPairing
   remoteOutputQ <- asks (tbqSize . config) >>= newTBQueueIO
-  http2Server <- async $ attachHTTP2Server tls $ handleRemoteCommand execChatCommand sessionKeys remoteOutputQ
+  encryption <- mkCtrlRemoteCrypto sessionKeys $ tlsUniq tls
+  http2Server <- async $ attachHTTP2Server tls $ handleRemoteCommand execChatCommand encryption remoteOutputQ
   void . forkIO $ monitor http2Server
   withRemoteCtrlSession $ \case
     RCSessionPendingConfirmation {} -> Right ((), RCSessionConnected {remoteCtrlId, rcsClient = client, rcsSession, tls, http2Server, remoteOutputQ})
diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs
index 62db487cb..eae71d09c 100644
--- a/src/Simplex/Chat/Remote/Protocol.hs
+++ b/src/Simplex/Chat/Remote/Protocol.hs
@@ -6,19 +6,26 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TupleSections #-}
 
 module Simplex.Chat.Remote.Protocol where
 
 import Control.Monad
 import Control.Monad.Except
+import Control.Monad.Reader
+import Crypto.Hash (SHA512)
+import qualified Crypto.Hash as CH
 import Data.Aeson ((.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Key as JK
 import qualified Data.Aeson.KeyMap as JM
 import Data.Aeson.TH (deriveJSON)
 import qualified Data.Aeson.Types as JT
+import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
-import Data.ByteString.Builder (Builder, lazyByteString, word32BE)
+import qualified Data.ByteString as B
+import Data.ByteString.Builder (Builder, byteString, lazyByteString)
 import qualified Data.ByteString.Lazy as LB
 import Data.String (fromString)
 import Data.Text (Text)
@@ -26,19 +33,25 @@ import Data.Text.Encoding (decodeUtf8)
 import Data.Word (Word32)
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Client as H
-import Network.Transport.Internal (decodeWord32)
+import Network.Transport.Internal (decodeWord32, encodeWord32)
 import Simplex.Chat.Controller
 import Simplex.Chat.Remote.Transport
 import Simplex.Chat.Remote.Types
 import Simplex.FileTransfer.Description (FileDigest (..))
+import Simplex.Messaging.Agent.Client (agentDRG)
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
+import Simplex.Messaging.Crypto.Lazy  (LazyByteString)
+import Simplex.Messaging.Encoding
 import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON, pattern SingleFieldJSONTag, pattern TaggedObjectJSONData, pattern TaggedObjectJSONTag)
 import Simplex.Messaging.Transport.Buffer (getBuffered)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), HTTP2BodyChunk, getBodyChunk)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2Response (..), closeHTTP2Client, sendRequestDirect)
 import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
-import Simplex.Messaging.Util (liftEitherError, liftEitherWith, tshow)
-import Simplex.RemoteControl.Types (HostSessKeys)
+import Simplex.Messaging.Util (liftEitherError, liftEitherWith, liftError, tshow)
+import Simplex.RemoteControl.Types (CtrlSessKeys (..), HostSessKeys (..), RCErrorType (..), SessionCode)
+import Simplex.RemoteControl.Client (xrcpBlockSize)
+import qualified Simplex.RemoteControl.Client as RC
 import System.FilePath (takeFileName, (</>))
 import UnliftIO
 
@@ -64,16 +77,29 @@ $(deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse)
 
 -- * Client side / desktop
 
-mkRemoteHostClient :: HTTP2Client -> HostSessKeys -> FilePath -> HostAppInfo -> RemoteHostClient
-mkRemoteHostClient httpClient sessionKeys storePath HostAppInfo {encoding, deviceName, encryptFiles} =
-  RemoteHostClient
-    { hostEncoding = encoding,
-      hostDeviceName = deviceName,
-      httpClient,
-      encryptHostFiles = encryptFiles,
-      sessionKeys,
-      storePath
-    }
+mkRemoteHostClient :: ChatMonad m => HTTP2Client -> HostSessKeys -> SessionCode -> FilePath -> HostAppInfo -> m RemoteHostClient
+mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {encoding, deviceName, encryptFiles} = do
+  drg <- asks $ agentDRG . smpAgent
+  counter <- newTVarIO 1
+  let HostSessKeys {hybridKey, idPrivKey, sessPrivKey} = sessionKeys
+      signatures = RSSign {idPrivKey, sessPrivKey}
+      encryption = RemoteCrypto {drg, counter, sessionCode, hybridKey, signatures}
+  pure
+    RemoteHostClient
+      { hostEncoding = encoding,
+        hostDeviceName = deviceName,
+        httpClient,
+        encryption,
+        encryptHostFiles = encryptFiles,
+        storePath
+      }
+
+mkCtrlRemoteCrypto :: ChatMonad m => CtrlSessKeys -> SessionCode -> m RemoteCrypto
+mkCtrlRemoteCrypto CtrlSessKeys {hybridKey, idPubKey, sessPubKey} sessionCode = do
+  drg <- asks $ agentDRG . smpAgent
+  counter <- newTVarIO 1
+  let signatures = RSVerify {idPubKey, sessPubKey}
+  pure RemoteCrypto {drg, counter, sessionCode, hybridKey, signatures}
 
 closeRemoteHostClient :: MonadIO m => RemoteHostClient -> m ()
 closeRemoteHostClient RemoteHostClient {httpClient} = liftIO $ closeHTTP2Client httpClient
@@ -81,28 +107,28 @@ closeRemoteHostClient RemoteHostClient {httpClient} = liftIO $ closeHTTP2Client
 -- ** Commands
 
 remoteSend :: RemoteHostClient -> ByteString -> ExceptT RemoteProtocolError IO ChatResponse
-remoteSend RemoteHostClient {httpClient, hostEncoding} cmd =
-  sendRemoteCommand' httpClient hostEncoding Nothing RCSend {command = decodeUtf8 cmd} >>= \case
+remoteSend c cmd =
+  sendRemoteCommand' c Nothing RCSend {command = decodeUtf8 cmd} >>= \case
     RRChatResponse cr -> pure cr
     r -> badResponse r
 
 remoteRecv :: RemoteHostClient -> Int -> ExceptT RemoteProtocolError IO (Maybe ChatResponse)
-remoteRecv RemoteHostClient {httpClient, hostEncoding} ms =
-  sendRemoteCommand' httpClient hostEncoding Nothing RCRecv {wait = ms} >>= \case
+remoteRecv c ms =
+  sendRemoteCommand' c Nothing RCRecv {wait = ms} >>= \case
     RRChatEvent cr_ -> pure cr_
     r -> badResponse r
 
 remoteStoreFile :: RemoteHostClient -> FilePath -> FilePath -> ExceptT RemoteProtocolError IO FilePath
-remoteStoreFile RemoteHostClient {httpClient, hostEncoding} localPath fileName = do
+remoteStoreFile c localPath fileName = do
   (fileSize, fileDigest) <- getFileInfo localPath
-  let send h = sendRemoteCommand' httpClient hostEncoding (Just (h, fileSize)) RCStoreFile {fileName, fileSize, fileDigest}
+  let send h = sendRemoteCommand' c (Just (h, fileSize)) RCStoreFile {fileName, fileSize, fileDigest}
   withFile localPath ReadMode send >>= \case
     RRFileStored {filePath = filePath'} -> pure filePath'
     r -> badResponse r
 
 remoteGetFile :: RemoteHostClient -> FilePath -> RemoteFile -> ExceptT RemoteProtocolError IO ()
-remoteGetFile RemoteHostClient {httpClient, hostEncoding} destDir rf@RemoteFile {fileSource = CryptoFile {filePath}} =
-  sendRemoteCommand httpClient hostEncoding Nothing RCGetFile {file = rf} >>= \case
+remoteGetFile c destDir rf@RemoteFile {fileSource = CryptoFile {filePath}} =
+  sendRemoteCommand c Nothing RCGetFile {file = rf} >>= \case
     (getChunk, RRFile {fileSize, fileDigest}) -> do
       -- TODO we could optimize by checking size and hash before receiving the file
       let localPath = destDir </> takeFileName filePath
@@ -110,18 +136,19 @@ remoteGetFile RemoteHostClient {httpClient, hostEncoding} destDir rf@RemoteFile
     (_, r) -> badResponse r
 
 -- TODO validate there is no attachment
-sendRemoteCommand' :: HTTP2Client -> PlatformEncoding -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO RemoteResponse
-sendRemoteCommand' http remoteEncoding attachment_ rc = snd <$> sendRemoteCommand http remoteEncoding attachment_ rc
+sendRemoteCommand' :: RemoteHostClient -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO RemoteResponse
+sendRemoteCommand' c attachment_ rc = snd <$> sendRemoteCommand c attachment_ rc
 
-sendRemoteCommand :: HTTP2Client -> PlatformEncoding -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO (Int -> IO ByteString, RemoteResponse)
-sendRemoteCommand http remoteEncoding attachment_ rc = do
-  HTTP2Response {response, respBody} <- liftEitherError (RPEHTTP2 . tshow) $ sendRequestDirect http httpRequest Nothing
-  (header, getNext) <- parseHTTP2Body response respBody
-  rr <- liftEitherWith (RPEInvalidJSON . fromString) $ J.eitherDecodeStrict header >>= JT.parseEither J.parseJSON . convertJSON remoteEncoding localEncoding
+sendRemoteCommand :: RemoteHostClient -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO (Int -> IO ByteString, RemoteResponse)
+sendRemoteCommand RemoteHostClient {httpClient, hostEncoding, encryption} attachment_ cmd = do
+  req <- httpRequest <$> encryptEncodeHTTP2Body encryption (J.encode cmd)
+  HTTP2Response {response, respBody} <- liftEitherError (RPEHTTP2 . tshow) $ sendRequestDirect httpClient req Nothing
+  (header, getNext) <- parseDecryptHTTP2Body encryption response respBody
+  rr <- liftEitherWith (RPEInvalidJSON . fromString) $ J.eitherDecode header >>= JT.parseEither J.parseJSON . convertJSON hostEncoding localEncoding
   pure (getNext, rr)
   where
-    httpRequest = H.requestStreaming N.methodPost "/" mempty $ \send flush -> do
-      send $ sizePrefixedEncode rc
+    httpRequest cmdBld = H.requestStreaming N.methodPost "/" mempty $ \send flush -> do
+      send cmdBld
       case attachment_ of
         Nothing -> pure ()
         Just (h, sz) -> hSendFile h send sz
@@ -175,18 +202,93 @@ owsf2tagged = fst . convert
 pattern OwsfTag :: (JK.Key, J.Value)
 pattern OwsfTag = (SingleFieldJSONTag, J.Bool True)
 
--- | Convert a command or a response into 'Builder'.
-sizePrefixedEncode :: J.ToJSON a => a -> Builder
-sizePrefixedEncode value = word32BE (fromIntegral $ LB.length json) <> lazyByteString json
-  where
-    json = J.encode value
+-- ```
+-- commandBody = encBody sessSignature idSignature (attachment / noAttachment)
+-- responseBody = encBody attachment; should match counter in the command
+-- encBody = nonce encLength32 encrypted(tlsunique counter body)
+-- attachment = %x01 nonce encLength32 encrypted(attachment)
+-- noAttachment = %x00
+-- tlsunique = length 1*OCTET
+-- nonce = 24*24 OCTET
+-- counter = 8*8 OCTET ; int64
+-- encLength32 = 4*4 OCTET ; uint32, includes authTag
+-- ```
 
--- | Parse HTTP request or response to a size-prefixed chunk and a function to read more.
-parseHTTP2Body :: HTTP2BodyChunk a => a -> HTTP2Body -> ExceptT RemoteProtocolError IO (ByteString, Int -> IO ByteString)
-parseHTTP2Body hr HTTP2Body {bodyBuffer} = do
-  rSize <- liftIO $ decodeWord32 <$> getNext 4
-  when (rSize > fromIntegral (maxBound :: Int)) $ throwError RPEInvalidSize
-  r <- liftIO $ getNext $ fromIntegral rSize
-  pure (r, getNext)
+-- See https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2023-10-25-remote-control.md for encoding
+
+encryptEncodeHTTP2Body :: RemoteCrypto -> LazyByteString -> ExceptT RemoteProtocolError IO Builder
+encryptEncodeHTTP2Body RemoteCrypto {drg, counter, sessionCode, hybridKey, signatures} s = do
+  corrId <- atomically $ stateTVar counter $ \c -> (c, c + 1)
+  let pfx = smpEncode (sessionCode, corrId)
+  (nonce, ct) <- liftError PRERemoteControl $ RC.rcEncryptBody drg hybridKey $ LB.fromStrict pfx <> s
+  let ctLen = encodeWord32 (fromIntegral $ LB.length ct)
+      signed = LB.fromStrict (smpEncode nonce <> ctLen) <> ct
+  sigs <- bodySignatures signed
+  pure $ lazyByteString signed <> sigs
   where
+    bodySignatures :: LazyByteString -> ExceptT RemoteProtocolError IO Builder
+    bodySignatures signed = case signatures of
+      RSSign {idPrivKey, sessPrivKey} -> do
+        let hc = CH.hashUpdates (CH.hashInit @SHA512) (LB.toChunks signed)
+            ssig = sign sessPrivKey hc
+            idsig = sign idPrivKey $ CH.hashUpdate hc ssig
+        pure $ byteString $ smpEncode (ssig, idsig)
+      _ -> pure mempty
+    sign :: C.PrivateKeyEd25519 -> CH.Context SHA512 -> ByteString
+    sign k = C.signatureBytes . C.sign' k . BA.convert . CH.hashFinalize
+
+-- | Parse and decrypt HTTP2 request/response
+parseDecryptHTTP2Body :: HTTP2BodyChunk a => RemoteCrypto -> a -> HTTP2Body -> ExceptT RemoteProtocolError IO (LazyByteString, Int -> IO ByteString)
+parseDecryptHTTP2Body RemoteCrypto {hybridKey, sessionCode, signatures} hr HTTP2Body {bodyBuffer} = do
+  (nonce, ct) <- getBody
+  s <- liftError PRERemoteControl $ RC.rcDecryptBody hybridKey nonce ct
+  (,getNext) <$> parseBody s
+  where
+    getBody :: ExceptT RemoteProtocolError IO (C.CbNonce, LazyByteString)
+    getBody = do
+      nonceStr <- liftIO $ getNext 24
+      nonce <- liftEitherWith RPEInvalidBody $ smpDecode nonceStr
+      ctLenStr <- liftIO $ getNext 4
+      let ctLen = decodeWord32 ctLenStr
+      when (ctLen > fromIntegral (maxBound :: Int)) $ throwError RPEInvalidSize
+      chunks <- liftIO $ getLazy $ fromIntegral ctLen
+      let hc = CH.hashUpdates (CH.hashInit @SHA512) [nonceStr, ctLenStr]
+          hc' = CH.hashUpdates hc chunks
+      verifySignatures hc'
+      pure (nonce, LB.fromChunks chunks)
+    getLazy :: Int -> IO [ByteString]
+    getLazy 0 = pure []
+    getLazy n = do
+      let sz = min n xrcpBlockSize
+      bs <- getNext sz
+      let n' = if B.length bs < sz then 0 else max 0 (n - xrcpBlockSize)
+      (bs :) <$> getLazy n'
+    verifySignatures :: CH.Context SHA512 -> ExceptT RemoteProtocolError IO ()
+    verifySignatures hc = case signatures of
+      RSVerify {sessPubKey, idPubKey} -> do
+        ssig <- getSig
+        idsig <- getSig
+        verifySig sessPubKey ssig hc
+        verifySig idPubKey idsig $ CH.hashUpdate hc $ C.signatureBytes ssig
+      _ -> pure ()
+      where
+        getSig = do
+          len <- liftIO $ B.head <$> getNext 1
+          liftEitherError RPEInvalidBody $ C.decodeSignature <$> getNext (fromIntegral len)
+        verifySig key sig hc' = do
+          let signed = BA.convert $ CH.hashFinalize hc'
+          unless (C.verify' key sig signed) $ throwError $ PRERemoteControl RCECtrlAuth
+    parseBody :: LazyByteString -> ExceptT RemoteProtocolError IO LazyByteString
+    parseBody s = case LB.uncons s of
+      Nothing -> throwError $ RPEInvalidBody "empty body"
+      Just (scLen, rest) -> do
+        (sessCode', rest') <- takeBytes (fromIntegral scLen) rest
+        unless (sessCode' == sessionCode) $ throwError PRESessionCode
+        (_corrId, s') <- takeBytes 8 rest'
+        pure s'
+      where
+        takeBytes n s' = do
+          let (bs, rest) = LB.splitAt n s'
+          unless (LB.length bs == n) $ throwError PRESessionCode
+          pure (LB.toStrict bs, rest)
     getNext sz = getBuffered bodyBuffer sz Nothing $ getBodyChunk hr
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index 638707563..3177ae3ef 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -10,11 +10,16 @@
 module Simplex.Chat.Remote.Types where
 
 import Control.Concurrent.Async (Async)
+import Control.Concurrent.STM (TVar)
 import Control.Exception (Exception)
+import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
+import Data.ByteString (ByteString)
 import Data.Int (Int64)
 import Data.Text (Text)
 import Simplex.Chat.Remote.AppVersion
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.SNTRUP761 (KEMHybridSecret)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import Simplex.RemoteControl.Client
@@ -26,11 +31,29 @@ data RemoteHostClient = RemoteHostClient
   { hostEncoding :: PlatformEncoding,
     hostDeviceName :: Text,
     httpClient :: HTTP2Client,
-    sessionKeys :: HostSessKeys,
+    encryption :: RemoteCrypto,
     encryptHostFiles :: Bool,
     storePath :: FilePath
   }
 
+data RemoteCrypto = RemoteCrypto
+  { drg :: TVar ChaChaDRG,
+    counter :: TVar Int64,
+    sessionCode :: ByteString,
+    hybridKey :: KEMHybridSecret,
+    signatures :: RemoteSignatures
+  }
+
+data RemoteSignatures
+  = RSSign
+    { idPrivKey :: C.PrivateKeyEd25519,
+      sessPrivKey :: C.PrivateKeyEd25519
+    }
+  | RSVerify
+    { idPubKey :: C.PublicKeyEd25519,
+      sessPubKey :: C.PublicKeyEd25519
+    }
+
 data RHPendingSession = RHPendingSession
   { rhKey :: RHKey,
     rchClient :: RCHostClient,
@@ -49,6 +72,8 @@ data RemoteProtocolError
     RPEInvalidSize
   | -- | failed to parse RemoteCommand or RemoteResponse
     RPEInvalidJSON {invalidJSON :: String}
+  | RPEInvalidBody {invalidBody :: String}
+  | PRESessionCode
   | RPEIncompatibleEncoding
   | RPEUnexpectedFile
   | RPENoFile
@@ -58,6 +83,7 @@ data RemoteProtocolError
     RPEUnexpectedResponse {response :: Text}
   | -- | A file already exists in the destination position
     RPEStoredFileExists
+  | PRERemoteControl {rcError :: RCErrorType}
   | RPEHTTP2 {http2Error :: Text}
   | RPEException {someException :: Text}
   deriving (Show, Exception)
diff --git a/stack.yaml b/stack.yaml
index c90140963..11920f531 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: bd06b47a9df13506ee77251868a5a1d1e7cadafe
+    commit: 6a2e6b040ec8566de2f4cf97bae6700a6a5cbeda
   - github: kazu-yamamoto/http2
     commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
   # - ../direct-sqlcipher

From 227007c8f611b62c7b5400d43f8cf54c52ce7469 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Fri, 10 Nov 2023 19:49:23 +0200
Subject: [PATCH 35/69] add /switch remote host (#3342)

* Add SwitchRemoteHost

* Add message test

* Match remote prefix and the rest of the line

* Move prefix match to utils
---
 src/Simplex/Chat.hs            |  2 ++
 src/Simplex/Chat/Controller.hs |  6 ++--
 src/Simplex/Chat/Remote.hs     | 11 +++++++
 src/Simplex/Chat/View.hs       |  6 ++++
 tests/ChatTests/Utils.hs       |  3 ++
 tests/RemoteTests.hs           | 52 ++++++++++++++++++++++++++++++++++
 6 files changed, 78 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 664661603..dad00fcef 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1953,6 +1953,7 @@ processChatCommand = \case
       p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
   SetLocalDeviceName name -> withUser_ $ chatWriteVar localDeviceName name >> ok_
   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}
@@ -5977,6 +5978,7 @@ chatCommandP =
       "/set device name " *> (SetLocalDeviceName <$> textP),
       -- "/create remote host" $> CreateRemoteHost,
       "/list remote hosts" $> ListRemoteHosts,
+      "/switch remote host " *> (SwitchRemoteHost <$> ("local" $> Nothing <|> (Just <$> A.decimal))),
       "/start remote host " *> (StartRemoteHost <$> ("new" $> Nothing <|> (Just <$> ((,) <$> A.decimal <*> (" multicast=" *> onOffP <|> pure False))))),
       "/stop remote host " *> (StopRemoteHost <$> ("new" $> RHNew <|> RHId <$> A.decimal)),
       "/delete remote host " *> (DeleteRemoteHost <$> A.decimal),
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 6832bb562..a9950372b 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -425,7 +425,7 @@ data ChatCommand
   -- | CreateRemoteHost -- ^ Configure a new remote host
   | ListRemoteHosts
   | StartRemoteHost (Maybe (RemoteHostId, Bool)) -- ^ Start new or known remote host with optional multicast for known host
-  -- | SwitchRemoteHost (Maybe RemoteHostId) -- ^ Switch current remote host
+  | SwitchRemoteHost (Maybe RemoteHostId) -- ^ Switch current remote host
   | StopRemoteHost RHKey -- ^ Shut down a running session
   | DeleteRemoteHost RemoteHostId -- ^ Unregister remote host and remove its data
   | StoreRemoteFile {remoteHostId :: RemoteHostId, storeEncrypted :: Maybe Bool, localPath :: FilePath}
@@ -456,7 +456,7 @@ allowRemoteCommand = \case
   QuitChat -> False
   ListRemoteHosts -> False
   StartRemoteHost _ -> False
-  -- SwitchRemoteHost {} -> False
+  SwitchRemoteHost {} -> False
   StoreRemoteFile {} -> False
   GetRemoteFile {} -> False
   StopRemoteHost _ -> False
@@ -644,6 +644,7 @@ data ChatResponse
   | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
   | CRRemoteHostCreated {remoteHost :: RemoteHostInfo}
   | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
+  | CRCurrentRemoteHost {remoteHost_ :: Maybe RemoteHostInfo}
   | CRRemoteHostStarted {remoteHost_ :: Maybe RemoteHostInfo, invitation :: Text}
   | CRRemoteHostSessionCode {remoteHost_ :: Maybe RemoteHostInfo, sessionCode :: Text}
   | CRRemoteHostConnected {remoteHost :: RemoteHostInfo}
@@ -1051,6 +1052,7 @@ throwDBError = throwError . ChatErrorDatabase
 -- TODO review errors, some of it can be covered by HTTP2 errors
 data RemoteHostError
   = RHEMissing -- ^ No remote session matches this identifier
+  | RHEInactive -- ^ A session exists, but not active
   | RHEBusy -- ^ A session is already running
   | RHEBadState -- ^ Illegal state transition
   | RHEBadVersion {appVersion :: AppVersion}
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 53b63d72b..ef5589e5a 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -248,6 +248,17 @@ listRemoteHosts = do
     rhInfo active rh@RemoteHost {remoteHostId} =
       remoteHostInfo rh (M.member (RHId remoteHostId) active)
 
+switchRemoteHost :: ChatMonad m => Maybe RemoteHostId -> m (Maybe RemoteHostInfo)
+switchRemoteHost rhId_ = do
+  rhi_ <- forM rhId_ $ \rhId -> do
+    let rhKey = RHId rhId
+    rhi <- withError (const $ ChatErrorRemoteHost rhKey RHEMissing) $ (`remoteHostInfo` True) <$> withStore (`getRemoteHost` rhId)
+    active <- chatReadVar remoteHostSessions
+    case M.lookup rhKey active of
+      Just RHSessionConnected {} -> pure rhi
+      _ -> 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 =
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index ca47cb15e..177f3400d 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -276,6 +276,12 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)]
   CRNtfMessages {} -> []
   CRRemoteHostCreated RemoteHostInfo {remoteHostId} -> ["remote host " <> sShow remoteHostId <> " created"]
+  CRCurrentRemoteHost rhi_ ->
+    [ maybe
+        "Using local profile"
+        (\RemoteHostInfo {remoteHostId = rhId, hostName} -> "Using remote host " <> sShow rhId <> " (" <> plain hostName <> ")")
+        rhi_
+    ]
   CRRemoteHostList hs -> viewRemoteHosts hs
   CRRemoteHostStarted {remoteHost_, invitation} ->
     [ maybe "new remote host started" (\RemoteHostInfo {remoteHostId = rhId} -> "remote host " <> sShow rhId <> " started") remoteHost_,
diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs
index a2aff4bf5..83b0d507b 100644
--- a/tests/ChatTests/Utils.hs
+++ b/tests/ChatTests/Utils.hs
@@ -327,6 +327,9 @@ cc ?<# line = (dropTime <$> getTermLine cc) `shouldReturn` "i " <> line
 ($<#) :: HasCallStack => (TestCC, String) -> String -> Expectation
 (cc, uName) $<# line = (dropTime . dropUser uName <$> getTermLine cc) `shouldReturn` line
 
+(^<#) :: HasCallStack => (TestCC, String) -> String -> Expectation
+(cc, p) ^<# line = (dropTime . dropStrPrefix p <$> getTermLine cc) `shouldReturn` line
+
 (⩗) :: HasCallStack => TestCC -> String -> Expectation
 cc ⩗ line = (dropTime . dropReceipt <$> getTermLine cc) `shouldReturn` line
 
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index b35e54032..9c135a81a 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -41,6 +41,8 @@ remoteTests = describe "Remote" $ do
   describe "remote files" $ do
     it "store/get/send/receive files" remoteStoreFileTest
     it "should send files from CLI wihtout /store" remoteCLIFileTest
+  it "switches remote hosts" switchRemoteHostTest
+  it "indicates remote hosts" indicateRemoteHostTest
 
 -- * Chat commands
 
@@ -323,6 +325,56 @@ remoteCLIFileTest = testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile
   where
     cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp/tmp"}
 
+switchRemoteHostTest :: FilePath -> IO ()
+switchRemoteHostTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
+  startRemote mobile desktop
+  contactBob desktop bob
+
+  desktop ##> "/contacts"
+  desktop <## "bob (Bob)"
+
+  desktop ##> "/switch remote host local"
+  desktop <## "Using local profile"
+  desktop ##> "/contacts"
+
+  desktop ##> "/switch remote host 1"
+  desktop <## "Using remote host 1 (Mobile)"
+  desktop ##> "/contacts"
+  desktop <## "bob (Bob)"
+
+  desktop ##> "/switch remote host 123"
+  desktop <## "remote host 123 error: RHEMissing"
+
+  stopDesktop mobile desktop
+  desktop ##> "/contacts"
+  desktop ##> "/switch remote host 1"
+  desktop <## "remote host 1 error: RHEInactive"
+  desktop ##> "/contacts"
+
+indicateRemoteHostTest :: FilePath -> IO ()
+indicateRemoteHostTest = testChat4 aliceProfile aliceDesktopProfile bobProfile cathProfile $ \mobile desktop bob cath -> do
+  connectUsers desktop cath
+  startRemote mobile desktop
+  contactBob desktop bob
+  -- remote contact -> remote host
+  bob #> "@alice hi"
+  desktop <#. "bob> hi"
+  -- local -> remote
+  cath #> "@alice_desktop hello"
+  (desktop, "[local] ") ^<# "cath> hello"
+  -- local -> local
+  desktop ##> "/switch remote host local"
+  desktop <## "Using local profile"
+  desktop <##> cath
+  -- local -> remote
+  bob #> "@alice what's up?"
+  (desktop, "[remote: 1] ") ^<# "bob> what's up?"
+
+  -- local -> local after disconnect
+  stopDesktop mobile desktop
+  desktop <##> cath
+  cath <##> desktop
+
 -- * Utils
 
 startRemote :: TestCC -> TestCC -> IO ()

From 8b67ff7a00efaf39338ead9eeeec2f49447b2938 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 11 Nov 2023 16:03:12 +0000
Subject: [PATCH 36/69] core: remote error handling (#3347)

* core: remote error handling

* fix test, show DB errors
---
 src/Simplex/Chat.hs        |  2 +-
 src/Simplex/Chat/Remote.hs | 61 ++++++++++++++++++--------------------
 src/Simplex/Chat/View.hs   |  2 ++
 tests/RemoteTests.hs       |  2 +-
 4 files changed, 33 insertions(+), 34 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index dad00fcef..88cb8dd25 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1955,7 +1955,7 @@ processChatCommand = \case
   ListRemoteHosts -> withUser_ $ CRRemoteHostList <$> listRemoteHosts
   SwitchRemoteHost rh_ -> withUser_ $ CRCurrentRemoteHost <$> switchRemoteHost rh_
   StartRemoteHost rh_ -> withUser_ $ do
-    (remoteHost_, inv) <- startRemoteHost' rh_
+    (remoteHost_, inv) <- startRemoteHost rh_
     pure CRRemoteHostStarted {remoteHost_, invitation = decodeLatin1 $ strEncode inv}
   StopRemoteHost rh_ -> withUser_ $ closeRemoteHost rh_ >> ok_
   DeleteRemoteHost rh -> withUser_ $ deleteRemoteHost rh >> ok_
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index ef5589e5a..6916a54a0 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -122,8 +122,8 @@ setNewRemoteHostId rhKey rhId = do
       Just s -> Right () <$ TM.insert (RHId rhId) s sessions
   liftEither r
 
-startRemoteHost' :: ChatMonad m => Maybe (RemoteHostId, Bool) -> m (Maybe RemoteHostInfo, RCSignedInvitation)
-startRemoteHost' rh_ = do
+startRemoteHost :: ChatMonad m => Maybe (RemoteHostId, Bool) -> m (Maybe RemoteHostInfo, RCSignedInvitation)
+startRemoteHost rh_ = do
   (rhKey, multicast, remoteHost_, pairing) <- case rh_ of
     Just (rhId, multicast) -> do
       rh@RemoteHost {hostPairing} <- withStore $ \db -> getRemoteHost db rhId
@@ -134,8 +134,9 @@ startRemoteHost' rh_ = do
   (invitation, rchClient, vars) <- withAgent $ \a -> rcConnectHost a pairing (J.toJSON ctrlAppInfo) multicast
   cmdOk <- newEmptyTMVarIO
   rhsWaitSession <- async $ do
+    rhKeyVar <- newTVarIO rhKey
     atomically $ takeTMVar cmdOk
-    cleanupOnError rchClient $ waitForSession remoteHost_ vars
+    handleHostError rhKeyVar $ waitForHostSession remoteHost_ rhKey rhKeyVar vars
   let rhs = RHPendingSession {rhKey, rchClient, rhsWaitSession, remoteHost_}
   withRemoteHostSession rhKey $ \case
     RHSessionStarting -> Right ((), RHSessionConnecting rhs)
@@ -152,18 +153,15 @@ startRemoteHost' rh_ = do
       unless (isAppCompatible appVersion ctrlAppVersionRange) $ throwError $ RHEBadVersion appVersion
       when (encoding == PEKotlin && localEncoding == PESwift) $ throwError $ RHEProtocolError RPEIncompatibleEncoding
       pure hostInfo
-    cleanupOnError :: ChatMonad m => RCHostClient -> (TMVar RHKey -> m ()) -> m ()
-    cleanupOnError rchClient action = do
-      currentKey <- newEmptyTMVarIO
-      action currentKey `catchChatError` \err -> do
-        logError $ "startRemoteHost'.waitForSession crashed: " <> tshow err
+    handleHostError :: ChatMonad m => TVar RHKey -> m () -> m ()
+    handleHostError rhKeyVar action = do
+      action `catchChatError` \err -> do
+        logError $ "startRemoteHost.waitForHostSession crashed: " <> tshow err
         sessions <- asks remoteHostSessions
-        atomically $ readTMVar currentKey >>= (`TM.delete` sessions)
-        liftIO $ cancelHostClient rchClient
-    waitForSession :: ChatMonad m => Maybe RemoteHostInfo -> RCStepTMVar (ByteString, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> TMVar RHKey -> m ()
-    waitForSession remoteHost_ vars currentKey = do
-      let rhKey = maybe RHNew (\RemoteHostInfo {remoteHostId} -> RHId remoteHostId) remoteHost_
-      atomically $ writeTMVar currentKey rhKey
+        session_ <- atomically $ readTVar rhKeyVar >>= (`TM.lookupDelete` sessions)
+        mapM_ (liftIO . cancelRemoteHost) session_
+    waitForHostSession :: ChatMonad m => Maybe RemoteHostInfo -> RHKey -> TVar RHKey -> RCStepTMVar (ByteString, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
+    waitForHostSession remoteHost_ rhKey rhKeyVar vars = do
       (sessId, vars') <- takeRCStep vars
       toView $ CRRemoteHostSessionCode {remoteHost_, sessionCode = verificationCode sessId} -- display confirmation code, wait for mobile to confirm
       (RCHostSession {tls, sessionKeys}, rhHello, pairing') <- takeRCStep vars'
@@ -175,7 +173,7 @@ startRemoteHost' rh_ = do
       -- update remoteHost with updated pairing
       rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' remoteHost_ hostDeviceName
       let rhKey' = RHId remoteHostId -- rhKey may be invalid after upserting on RHNew
-      atomically $ writeTMVar currentKey rhKey'
+      atomically $ writeTVar rhKeyVar rhKey'
       disconnected <- toIO $ onDisconnected remoteHostId
       httpClient <- liftEitherError (httpError rhKey') $ attachRevHTTP2Client disconnected tls
       rhClient <- mkRemoteHostClient httpClient sessionKeys sessId storePath hostInfo
@@ -252,7 +250,7 @@ switchRemoteHost :: ChatMonad m => Maybe RemoteHostId -> m (Maybe RemoteHostInfo
 switchRemoteHost rhId_ = do
   rhi_ <- forM rhId_ $ \rhId -> do
     let rhKey = RHId rhId
-    rhi <- withError (const $ ChatErrorRemoteHost rhKey RHEMissing) $ (`remoteHostInfo` True) <$> withStore (`getRemoteHost` rhId)
+    rhi <- (`remoteHostInfo` True) <$> withStore (`getRemoteHost` rhId)
     active <- chatReadVar remoteHostSessions
     case M.lookup rhKey active of
       Just RHSessionConnected {} -> pure rhi
@@ -338,19 +336,14 @@ connectRemoteCtrl inv@RCSignedInvitation {invitation = RCInvitation {ca, app}} =
   cmdOk <- newEmptyTMVarIO
   rcsWaitSession <- async $ do
     atomically $ takeTMVar cmdOk
-    cleanupOnError rcsClient $ waitForSession rc_ ctrlDeviceName rcsClient vars
-  cleanupOnError rcsClient . updateRemoteCtrlSession $ \case
+    handleCtrlError "waitForCtrlSession" $ waitForCtrlSession rc_ ctrlDeviceName rcsClient vars
+  handleCtrlError "connectRemoteCtrl" . updateRemoteCtrlSession $ \case
     RCSessionStarting -> Right RCSessionConnecting {rcsClient, rcsWaitSession}
     _ -> Left $ ChatErrorRemoteCtrl RCEBadState
   atomically $ putTMVar cmdOk ()
   where
-    cleanupOnError :: ChatMonad m => RCCtrlClient -> m () -> m ()
-    cleanupOnError rcsClient action = action `catchChatError` \e -> do
-      logError $ "connectRemoteCtrl crashed with: " <> tshow e
-      chatWriteVar remoteCtrlSession Nothing -- XXX: can only wipe PendingConfirmation or RCSessionConnecting, which only have rcsClient to cancel
-      liftIO $ cancelCtrlClient rcsClient
-    waitForSession :: ChatMonad m => Maybe RemoteCtrl -> Text -> RCCtrlClient -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> m ()
-    waitForSession rc_ ctrlName rcsClient vars = do
+    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}
@@ -487,7 +480,7 @@ confirmRemoteCtrl _rcId = do
 
 -- | 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' = cleanupOnError $ do
+verifyRemoteCtrlSession execChatCommand sessCode' = handleCtrlError "verifyRemoteCtrlSession" $ do
   (client, ctrlName, sessionCode, vars) <-
     getRemoteCtrlSession >>= \case
       RCSessionPendingConfirmation {rcsClient, ctrlName, sessionCode, rcsWaitConfirmation} -> pure (rcsClient, ctrlName, sessionCode, rcsWaitConfirmation)
@@ -514,16 +507,11 @@ verifyRemoteCtrlSession execChatCommand sessCode' = cleanupOnError $ do
         Just rc@RemoteCtrl {remoteCtrlId} -> do
           liftIO $ updateCtrlPairingKeys db remoteCtrlId (dhPrivKey rcCtrlPairing)
           pure rc
-    cleanupOnError :: ChatMonad m => m a -> m a
-    cleanupOnError action = action `catchChatError` \e -> do
-      logError $ "verifyRemoteCtrlSession crashed with: " <> tshow e
-      withRemoteCtrlSession_ (\s -> pure (s, Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl) -- cancel session threads, if any
-      throwError e
     monitor :: ChatMonad m => Async () -> m ()
     monitor server = do
       res <- waitCatch server
       logInfo $ "HTTP2 server stopped: " <> tshow res
-      withRemoteCtrlSession_ (\s -> pure (s, Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl) -- cancel session threads, if any
+      cancelActiveRemoteCtrl
       toView CRRemoteCtrlStopped
 
 stopRemoteCtrl :: ChatMonad m => m ()
@@ -531,6 +519,15 @@ stopRemoteCtrl =
   join . withRemoteCtrlSession_ . maybe (Left $ ChatErrorRemoteCtrl RCEInactive) $
     \s -> Right (liftIO $ cancelRemoteCtrl s, Nothing)
 
+handleCtrlError :: ChatMonad m => Text -> m a -> m a
+handleCtrlError name action = action `catchChatError` \e -> do
+  logError $ name <> " remote ctrl error: " <> tshow e
+  cancelActiveRemoteCtrl
+  throwError e
+
+cancelActiveRemoteCtrl :: ChatMonad m => m ()
+cancelActiveRemoteCtrl = withRemoteCtrlSession_ (\s -> pure (s, Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl)
+
 cancelRemoteCtrl :: RemoteCtrlSession -> IO ()
 cancelRemoteCtrl = \case
   RCSessionStarting -> pure ()
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 177f3400d..f96857fd4 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -1822,6 +1822,8 @@ viewChatError logLevel = \case
     SEChatItemNotFoundByText text -> ["message not found by text: " <> plain text]
     SEDuplicateGroupLink g -> ["you already have link for this group, to show: " <> highlight ("/show link #" <> viewGroupName g)]
     SEGroupLinkNotFound g -> ["no group link, to create: " <> highlight ("/create link #" <> viewGroupName g)]
+    SERemoteCtrlNotFound rcId -> ["no remote controller " <> sShow rcId]
+    SERemoteHostNotFound rhId -> ["no remote host " <> sShow rhId]
     e -> ["chat db error: " <> sShow e]
   ChatErrorDatabase err -> case err of
     DBErrorEncrypted -> ["error: chat database is already encrypted"]
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 9c135a81a..4aaa3b68c 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -343,7 +343,7 @@ switchRemoteHostTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \
   desktop <## "bob (Bob)"
 
   desktop ##> "/switch remote host 123"
-  desktop <## "remote host 123 error: RHEMissing"
+  desktop <## "no remote host 123"
 
   stopDesktop mobile desktop
   desktop ##> "/contacts"

From 8e3e58cac805a091593b26309ffc3ad9c30edddc Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 12 Nov 2023 12:40:13 +0000
Subject: [PATCH 37/69] core: update remote controller name (#3352)

---
 src/Simplex/Chat/Remote.hs       | 10 +++++-----
 src/Simplex/Chat/Store/Remote.hs |  8 ++++----
 2 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 6916a54a0..9acde9404 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -29,13 +29,12 @@ import Data.ByteString.Builder (Builder)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isNothing)
+import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Data.Word (Word16, Word32)
 import qualified Network.HTTP.Types as N
-import Network.HTTP2.Client (HTTP2Error (..))
 import Network.HTTP2.Server (responseStreaming)
 import qualified Paths_simplex_chat as SC
 import Simplex.Chat.Archive (archiveFilesFolder)
@@ -504,9 +503,10 @@ verifyRemoteCtrlSession execChatCommand sessCode' = handleCtrlError "verifyRemot
       rc_ <- liftIO $ getRemoteCtrlByFingerprint db (ctrlFingerprint rcCtrlPairing)
       case rc_ of
         Nothing -> insertRemoteCtrl db ctrlName rcCtrlPairing >>= getRemoteCtrl db
-        Just rc@RemoteCtrl {remoteCtrlId} -> do
-          liftIO $ updateCtrlPairingKeys db remoteCtrlId (dhPrivKey rcCtrlPairing)
-          pure rc
+        Just rc@RemoteCtrl {ctrlPairing} -> do
+          let dhPrivKey' = dhPrivKey rcCtrlPairing
+          liftIO $ updateRemoteCtrl db rc ctrlName dhPrivKey'
+          pure rc {ctrlName, ctrlPairing = ctrlPairing {dhPrivKey = dhPrivKey'}}
     monitor :: ChatMonad m => Async () -> m ()
     monitor server = do
       res <- waitCatch server
diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs
index e12b58125..22eda53c7 100644
--- a/src/Simplex/Chat/Store/Remote.hs
+++ b/src/Simplex/Chat/Store/Remote.hs
@@ -130,16 +130,16 @@ toRemoteCtrl (remoteCtrlId, ctrlName, caKey, C.SignedObject caCert, ctrlFingerpr
       ctrlPairing = RCCtrlPairing {caKey, caCert, ctrlFingerprint, idPubKey, dhPrivKey, prevDhPrivKey}
     }
 
-updateCtrlPairingKeys :: DB.Connection -> RemoteCtrlId -> C.PrivateKeyX25519 -> IO ()
-updateCtrlPairingKeys db rcId dhPrivKey =
+updateRemoteCtrl :: DB.Connection -> RemoteCtrl -> Text -> C.PrivateKeyX25519 -> IO ()
+updateRemoteCtrl db RemoteCtrl {remoteCtrlId} ctrlDeviceName dhPrivKey =
   DB.execute
     db
     [sql|
       UPDATE remote_controllers
-      SET dh_priv_key = ?, prev_dh_priv_key = dh_priv_key
+      SET ctrl_device_name = ?, dh_priv_key = ?, prev_dh_priv_key = dh_priv_key
       WHERE remote_ctrl_id = ?
     |]
-    (dhPrivKey, rcId)
+    (ctrlDeviceName, dhPrivKey, remoteCtrlId)
 
 deleteRemoteCtrlRecord :: DB.Connection -> RemoteCtrlId -> IO ()
 deleteRemoteCtrlRecord db remoteCtrlId =

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 38/69] 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

From 72b25385ba389fceddf1e7f3e1d3836ffe49471e Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 12 Nov 2023 21:43:43 +0000
Subject: [PATCH 39/69] core: event when new remote host added (#3355)

---
 src/Simplex/Chat/Controller.hs | 6 ++----
 src/Simplex/Chat/Remote.hs     | 6 ++++--
 src/Simplex/Chat/View.hs       | 2 +-
 tests/RemoteTests.hs           | 1 +
 4 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index b4f69d908..84bbe3733 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -422,7 +422,6 @@ data ChatCommand
   | SetContactTimedMessages ContactName (Maybe TimedMessagesEnabled)
   | SetGroupTimedMessages GroupName (Maybe Int)
   | SetLocalDeviceName Text
-  -- | CreateRemoteHost -- ^ Configure a new remote host
   | ListRemoteHosts
   | StartRemoteHost (Maybe (RemoteHostId, Bool)) -- ^ Start new or known remote host with optional multicast for known host
   | SwitchRemoteHost (Maybe RemoteHostId) -- ^ Switch current remote host
@@ -642,17 +641,17 @@ data ChatResponse
   | CRNtfMessages {user_ :: Maybe User, connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}
   | CRNewContactConnection {user :: User, connection :: PendingContactConnection}
   | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
-  | CRRemoteHostCreated {remoteHost :: RemoteHostInfo}
   | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
   | CRCurrentRemoteHost {remoteHost_ :: Maybe RemoteHostInfo}
   | CRRemoteHostStarted {remoteHost_ :: Maybe RemoteHostInfo, invitation :: Text}
   | CRRemoteHostSessionCode {remoteHost_ :: Maybe RemoteHostInfo, sessionCode :: Text}
+  | CRNewRemoteHost {remoteHost :: RemoteHostInfo}
   | CRRemoteHostConnected {remoteHost :: RemoteHostInfo}
   | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
   | CRRemoteFileStored {remoteHostId :: RemoteHostId, remoteFileSource :: CryptoFile}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrlInfo} -- registered fingerprint, may connect
-  | CRRemoteCtrlConnecting {remoteCtrl_ :: Maybe RemoteCtrlInfo, ctrlAppInfo :: CtrlAppInfo, appVersion :: AppVersion} -- TODO is remove
+  | CRRemoteCtrlConnecting {remoteCtrl_ :: Maybe RemoteCtrlInfo, ctrlAppInfo :: CtrlAppInfo, appVersion :: AppVersion}
   | CRRemoteCtrlSessionCode {remoteCtrl_ :: Maybe RemoteCtrlInfo, sessionCode :: Text}
   | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo}
   | CRRemoteCtrlStopped
@@ -675,7 +674,6 @@ data ChatResponse
 
 allowRemoteEvent :: ChatResponse -> Bool
 allowRemoteEvent = \case
-  CRRemoteHostCreated {} -> False
   CRRemoteHostList {} -> False
   CRRemoteHostConnected {} -> False
   CRRemoteHostStopped {} -> False
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 0ba5f5fed..57dcd33e4 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -172,7 +172,9 @@ startRemoteHost rh_ = do
       -- update remoteHost with updated pairing
       rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' remoteHost_ hostDeviceName
       let rhKey' = RHId remoteHostId -- rhKey may be invalid after upserting on RHNew
-      atomically $ writeTVar rhKeyVar rhKey'
+      when (rhKey' /= rhKey) $ do
+        atomically $ writeTVar rhKeyVar rhKey'
+        toView $ CRNewRemoteHost rhi
       disconnected <- toIO $ onDisconnected remoteHostId
       httpClient <- liftEitherError (httpError rhKey') $ attachRevHTTP2Client disconnected tls
       rhClient <- mkRemoteHostClient httpClient sessionKeys sessId storePath hostInfo
@@ -193,7 +195,7 @@ startRemoteHost rh_ = do
           pure $ remoteHostInfo rh True
         Just rhi@RemoteHostInfo {remoteHostId} -> do
           withStore' $ \db -> updateHostPairing db remoteHostId hostDeviceName hostDhPubKey'
-          pure rhi
+          pure (rhi :: RemoteHostInfo) {sessionActive = True}
     onDisconnected :: ChatMonad m => RemoteHostId -> m ()
     onDisconnected remoteHostId = do
       logDebug "HTTP2 client disconnected"
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index d1871deb7..f3011e410 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -278,7 +278,6 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
   CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)]
   CRNtfMessages {} -> []
-  CRRemoteHostCreated RemoteHostInfo {remoteHostId} -> ["remote host " <> sShow remoteHostId <> " created"]
   CRCurrentRemoteHost rhi_ ->
     [ maybe
         "Using local profile"
@@ -296,6 +295,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
       "Compare session code with host:",
       plain sessionCode
     ]
+  CRNewRemoteHost RemoteHostInfo {remoteHostId = rhId, hostDeviceName} -> ["new remote host " <> sShow rhId <> " added: " <> plain hostDeviceName]
   CRRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} -> ["remote host " <> sShow rhId <> " connected"]
   CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
   CRRemoteFileStored rhId (CryptoFile filePath cfArgs_) ->
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 35f7d15b2..664797112 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -397,6 +397,7 @@ startRemote mobile desktop = do
   mobile <## ("/verify remote ctrl " <> sessId)
   mobile ##> ("/verify remote ctrl " <> sessId)
   mobile <## "remote controller 1 session started with My desktop"
+  desktop <## "new remote host 1 added: Mobile"
   desktop <## "remote host 1 connected"
 
 startRemoteStored :: TestCC -> TestCC -> IO ()

From 598b6659ccfe410f1264eb65876b4dfbc1026a3f Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Mon, 13 Nov 2023 20:39:41 +0200
Subject: [PATCH 40/69] core: better handling of remote errors (#3358)

* Allow ExitCode exceptions to do their job

* Use appropriate error type

* Close TLS server when cancelling connected remote host

* Add timeout errors

* Bump simplexmq

* extract common timeout value
---
 cabal.project                    |  2 +-
 src/Simplex/Chat.hs              |  9 +++++++--
 src/Simplex/Chat/Controller.hs   |  3 ++-
 src/Simplex/Chat/Remote.hs       | 26 +++++++++++++++++---------
 src/Simplex/Chat/Remote/Types.hs |  8 +++++++-
 5 files changed, 34 insertions(+), 14 deletions(-)

diff --git a/cabal.project b/cabal.project
index 5730bfb7b..c9273ea95 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: c051ebab74632e0eb60686329ab3fad521736f79
+    tag: 4f5d52ada47a15532766b2ff3d3781be629648d8
 
 source-repository-package
     type: git
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 60e861a48..8b9abfde5 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -103,7 +103,7 @@ import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (defaultSocksProxy)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
-import System.Exit (exitFailure, exitSuccess)
+import System.Exit (ExitCode, exitFailure, exitSuccess)
 import System.FilePath (takeFileName, (</>))
 import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, stdout)
 import System.Random (randomRIO)
@@ -411,7 +411,12 @@ execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> ChatCommand -
 execRemoteCommand u rhId cmd s = handleCommandError u $ getRemoteHostClient rhId >>= \rh -> processRemoteCommand rhId rh cmd s
 
 handleCommandError :: ChatMonad' m => Maybe User -> ExceptT ChatError m ChatResponse -> m ChatResponse
-handleCommandError u a = either (CRChatCmdError u) id <$> (runExceptT a `E.catch` (pure . Left . mkChatError))
+handleCommandError u a = either (CRChatCmdError u) id <$> (runExceptT a `E.catches` ioErrors)
+  where
+    ioErrors =
+      [ E.Handler $ \(e :: ExitCode) -> E.throwIO e,
+        E.Handler $ pure . Left . mkChatError
+      ]
 
 parseChatCommand :: ByteString -> Either String ChatCommand
 parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 84bbe3733..622ce7b70 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -1048,6 +1048,7 @@ data RemoteHostError
   = RHEMissing -- ^ No remote session matches this identifier
   | RHEInactive -- ^ A session exists, but not active
   | RHEBusy -- ^ A session is already running
+  | RHETimeout
   | RHEBadState -- ^ Illegal state transition
   | RHEBadVersion {appVersion :: AppVersion}
   | RHEDisconnected {reason :: Text} -- TODO should be sent when disconnected?
@@ -1059,10 +1060,10 @@ data RemoteCtrlError
   = RCEInactive -- ^ No session is running
   | RCEBadState -- ^ A session is in a wrong state for the current operation
   | RCEBusy -- ^ A session is already running
+  | RCETimeout
   | RCEDisconnected {remoteCtrlId :: RemoteCtrlId, reason :: Text} -- ^ A session disconnected by a controller
   | RCEBadInvitation
   | RCEBadVersion {appVersion :: AppVersion}
-  | RCEBadVerificationCode -- ^ The code submitted doesn't match session TLSunique
   | RCEHTTP2Error {http2Error :: Text} -- TODO currently not used
   | RCEProtocolError {protocolError :: RemoteProtocolError}
   deriving (Show, Exception)
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 57dcd33e4..e819f0224 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -90,6 +90,9 @@ ctrlAppVersionRange = mkAppVersionRange minRemoteHostVersion currentAppVersion
 hostAppVersionRange :: AppVersionRange
 hostAppVersionRange = mkAppVersionRange minRemoteCtrlVersion currentAppVersion
 
+networkIOTimeout :: Int
+networkIOTimeout = 15000000
+
 -- * Desktop side
 
 getRemoteHostClient :: ChatMonad m => RemoteHostId -> m RemoteHostClient
@@ -161,9 +164,9 @@ startRemoteHost rh_ = do
         mapM_ (liftIO . cancelRemoteHost) session_
     waitForHostSession :: ChatMonad m => Maybe RemoteHostInfo -> RHKey -> TVar RHKey -> RCStepTMVar (ByteString, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
     waitForHostSession remoteHost_ rhKey rhKeyVar vars = do
-      (sessId, vars') <- takeRCStep vars
+      (sessId, vars') <- takeRCStep vars -- no timeout, waiting for user to scan invite
       toView $ CRRemoteHostSessionCode {remoteHost_, sessionCode = verificationCode sessId} -- display confirmation code, wait for mobile to confirm
-      (RCHostSession {tls, sessionKeys}, rhHello, pairing') <- takeRCStep vars'
+      (RCHostSession {tls, sessionKeys}, rhHello, pairing') <- takeRCStep vars' -- no timeout, waiting for user to compare the code
       hostInfo@HostAppInfo {deviceName = hostDeviceName} <-
         liftError (ChatErrorRemoteHost rhKey) $ parseHostAppInfo rhHello
       withRemoteHostSession rhKey $ \case
@@ -180,7 +183,7 @@ startRemoteHost rh_ = do
       rhClient <- mkRemoteHostClient httpClient sessionKeys sessId storePath hostInfo
       pollAction <- async $ pollEvents remoteHostId rhClient
       withRemoteHostSession rhKey' $ \case
-        RHSessionConfirmed _ RHPendingSession {} -> Right ((), RHSessionConnected {tls, rhClient, pollAction, storePath})
+        RHSessionConfirmed _ RHPendingSession {rchClient} -> Right ((), RHSessionConnected {rchClient, tls, rhClient, pollAction, storePath})
         _ -> Left $ ChatErrorRemoteHost rhKey' RHEBadState
       chatWriteVar currentRemoteHost $ Just remoteHostId -- this is required for commands to be passed to remote host
       toView $ CRRemoteHostConnected rhi
@@ -216,7 +219,7 @@ closeRemoteHost :: ChatMonad m => RHKey -> m ()
 closeRemoteHost rhKey = do
   logNote $ "Closing remote host session for " <> tshow rhKey
   chatModifyVar currentRemoteHost $ \cur -> if (RHId <$> cur) == Just rhKey then Nothing else cur -- only wipe the closing RH
-  join . withRemoteHostSession_ rhKey . maybe (Left $ ChatErrorRemoteCtrl RCEInactive) $
+  join . withRemoteHostSession_ rhKey . maybe (Left $ ChatErrorRemoteHost rhKey RHEInactive) $
     \s -> Right (liftIO $ cancelRemoteHost s, Nothing)
 
 cancelRemoteHost :: RemoteHostSession -> IO ()
@@ -226,10 +229,11 @@ cancelRemoteHost = \case
   RHSessionConfirmed tls rhs -> do
     cancelPendingSession rhs
     closeConnection tls
-  RHSessionConnected {tls, rhClient = RemoteHostClient {httpClient}, pollAction} -> do
+  RHSessionConnected {rchClient, tls, rhClient = RemoteHostClient {httpClient}, pollAction} -> do
     uninterruptibleCancel pollAction
     closeHTTP2Client httpClient
     closeConnection tls
+    cancelHostClient rchClient
   where
     cancelPendingSession RHPendingSession {rchClient, rhsWaitSession} = do
       uninterruptibleCancel rhsWaitSession
@@ -333,7 +337,8 @@ connectRemoteCtrl signedInv@RCSignedInvitation {invitation = inv@RCInvitation {c
   rc_ <- withStore' $ \db -> getRemoteCtrlByFingerprint db ca
   mapM_ (validateRemoteCtrl inv) rc_
   hostAppInfo <- getHostAppInfo v
-  (rcsClient, vars) <- withAgent $ \a -> rcConnectCtrlURI a signedInv (ctrlPairing <$> rc_) (J.toJSON hostAppInfo)
+  (rcsClient, vars) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout . withAgent $ \a ->
+    rcConnectCtrlURI a signedInv (ctrlPairing <$> rc_) (J.toJSON hostAppInfo)
   cmdOk <- newEmptyTMVarIO
   rcsWaitSession <- async $ do
     atomically $ takeTMVar cmdOk
@@ -348,7 +353,7 @@ connectRemoteCtrl signedInv@RCSignedInvitation {invitation = inv@RCInvitation {c
       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
+      (uniq, tls, rcsWaitConfirmation) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout $ takeRCStep vars
       let sessionCode = verificationCode uniq
       toView CRRemoteCtrlSessionCode {remoteCtrl_ = (`remoteCtrlInfo` True) <$> rc_, sessionCode}
       updateRemoteCtrlSession $ \case
@@ -397,6 +402,9 @@ 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
 
@@ -490,9 +498,9 @@ verifyRemoteCtrlSession execChatCommand sessCode' = handleCtrlError "verifyRemot
       RCSessionPendingConfirmation {rcsClient, ctrlDeviceName = ctrlName, sessionCode, rcsWaitConfirmation} -> pure (rcsClient, ctrlName, sessionCode, rcsWaitConfirmation)
       _ -> throwError $ ChatErrorRemoteCtrl RCEBadState
   let verified = sameVerificationCode sessCode' sessionCode
-  liftIO $ confirmCtrlSession client verified
+  timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout . liftIO $ confirmCtrlSession client verified -- signal verification result before crashing
   unless verified $ throwError $ ChatErrorRemoteCtrl $ RCEProtocolError PRESessionCode
-  (rcsSession@RCCtrlSession {tls, sessionKeys}, rcCtrlPairing) <- takeRCStep vars
+  (rcsSession@RCCtrlSession {tls, sessionKeys}, rcCtrlPairing) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout $ takeRCStep vars
   rc@RemoteCtrl {remoteCtrlId} <- upsertRemoteCtrl ctrlName rcCtrlPairing
   remoteOutputQ <- asks (tbqSize . config) >>= newTBQueueIO
   encryption <- mkCtrlRemoteCrypto sessionKeys $ tlsUniq tls
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index 419339e41..17ea8e159 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -65,7 +65,13 @@ data RemoteHostSession
   = RHSessionStarting
   | RHSessionConnecting {rhPendingSession :: RHPendingSession}
   | RHSessionConfirmed {tls :: TLS, rhPendingSession :: RHPendingSession}
-  | RHSessionConnected {tls :: TLS, rhClient :: RemoteHostClient, pollAction :: Async (), storePath :: FilePath}
+  | RHSessionConnected
+    { rchClient :: RCHostClient,
+      tls :: TLS,
+      rhClient :: RemoteHostClient,
+      pollAction :: Async (),
+      storePath :: FilePath
+    }
 
 data RemoteProtocolError
   = -- | size prefix is malformed

From c91625b32a412514bc48a00dcffd44f8336f2b97 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 13 Nov 2023 20:16:34 +0000
Subject: [PATCH 41/69] core: update remote host session state, terminate TLS
 in one more case (#3364)

* core: update remote host session state, terminate TLS in one more case

* name
---
 cabal.project                    |  2 +-
 scripts/nix/sha256map.nix        |  2 +-
 src/Simplex/Chat/Remote.hs       | 57 ++++++++++++++++++--------------
 src/Simplex/Chat/Remote/Types.hs | 24 ++++++++++++--
 src/Simplex/Chat/View.hs         | 12 +++++--
 stack.yaml                       |  2 +-
 tests/RemoteTests.hs             |  4 +--
 7 files changed, 69 insertions(+), 34 deletions(-)

diff --git a/cabal.project b/cabal.project
index c9273ea95..f7102312c 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: 4f5d52ada47a15532766b2ff3d3781be629648d8
+    tag: e0b7942e45e36d92625e07c0c1ce9ca2375a0980
 
 source-repository-package
     type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index edc6f2fd2..d7870a87c 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."c051ebab74632e0eb60686329ab3fad521736f79" = "1j7z3v3vk02nq4sw46flky1l4pjxfiypbwh5s77m6f81rc0vsjvi";
+  "https://github.com/simplex-chat/simplexmq.git"."e0b7942e45e36d92625e07c0c1ce9ca2375a0980" = "0swbcrmdirwqrk0kx5jmc5lcrzasccfwn3papb5c1p8hn0hjnzj7";
   "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/Remote.hs b/src/Simplex/Chat/Remote.hs
index e819f0224..bb9610712 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -32,7 +32,7 @@ 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 (encodeUtf8)
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Word (Word16, Word32)
 import qualified Network.HTTP.Types as N
 import Network.HTTP2.Server (responseStreaming)
@@ -129,7 +129,7 @@ startRemoteHost rh_ = do
   (rhKey, multicast, remoteHost_, pairing) <- case rh_ of
     Just (rhId, multicast) -> do
       rh@RemoteHost {hostPairing} <- withStore $ \db -> getRemoteHost db rhId
-      pure (RHId rhId, multicast, Just $ remoteHostInfo rh True, hostPairing) -- get from the database, start multicast if requested
+      pure (RHId rhId, multicast, Just $ remoteHostInfo rh $ Just RHSStarting, hostPairing) -- get from the database, start multicast if requested
     Nothing -> (RHNew,False,Nothing,) <$> rcNewHostPairing
   withRemoteHostSession_ rhKey $ maybe (Right ((), Just RHSessionStarting)) (\_ -> Left $ ChatErrorRemoteHost rhKey RHEBusy)
   ctrlAppInfo <- mkCtrlAppInfo
@@ -141,7 +141,9 @@ startRemoteHost rh_ = do
     handleHostError rhKeyVar $ waitForHostSession remoteHost_ rhKey rhKeyVar vars
   let rhs = RHPendingSession {rhKey, rchClient, rhsWaitSession, remoteHost_}
   withRemoteHostSession rhKey $ \case
-    RHSessionStarting -> Right ((), RHSessionConnecting rhs)
+    RHSessionStarting ->
+      let inv = decodeLatin1 $ strEncode invitation
+       in Right ((), RHSessionConnecting inv rhs)
     _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
   (remoteHost_, invitation) <$ atomically (putTMVar cmdOk ())
   where
@@ -162,18 +164,22 @@ startRemoteHost rh_ = do
         sessions <- asks remoteHostSessions
         session_ <- atomically $ readTVar rhKeyVar >>= (`TM.lookupDelete` sessions)
         mapM_ (liftIO . cancelRemoteHost) session_
-    waitForHostSession :: ChatMonad m => Maybe RemoteHostInfo -> RHKey -> TVar RHKey -> RCStepTMVar (ByteString, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
+    waitForHostSession :: ChatMonad m => Maybe RemoteHostInfo -> RHKey -> TVar RHKey -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
     waitForHostSession remoteHost_ rhKey rhKeyVar vars = do
-      (sessId, vars') <- takeRCStep vars -- no timeout, waiting for user to scan invite
+      (sessId, tls, vars') <- takeRCStep vars -- no timeout, waiting for user to scan invite
+      let sessCode = verificationCode sessId
+      withRemoteHostSession rhKey $ \case
+        RHSessionConnecting _inv rhs' -> Right ((), RHSessionPendingConfirmation sessCode tls rhs') -- TODO check it's the same session?
+        _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
       toView $ CRRemoteHostSessionCode {remoteHost_, sessionCode = verificationCode sessId} -- display confirmation code, wait for mobile to confirm
-      (RCHostSession {tls, sessionKeys}, rhHello, pairing') <- takeRCStep vars' -- no timeout, waiting for user to compare the code
+      (RCHostSession {sessionKeys}, rhHello, pairing') <- takeRCStep vars' -- no timeout, waiting for user to compare the code
       hostInfo@HostAppInfo {deviceName = hostDeviceName} <-
         liftError (ChatErrorRemoteHost rhKey) $ parseHostAppInfo rhHello
       withRemoteHostSession rhKey $ \case
-        RHSessionConnecting rhs' -> Right ((), RHSessionConfirmed tls rhs') -- TODO check it's the same session?
+        RHSessionPendingConfirmation _ tls' rhs' -> Right ((), RHSessionConfirmed tls' rhs') -- TODO check it's the same session?
         _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
       -- update remoteHost with updated pairing
-      rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' remoteHost_ hostDeviceName
+      rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' remoteHost_ hostDeviceName RHSConfirmed
       let rhKey' = RHId remoteHostId -- rhKey may be invalid after upserting on RHNew
       when (rhKey' /= rhKey) $ do
         atomically $ writeTVar rhKeyVar rhKey'
@@ -187,18 +193,18 @@ startRemoteHost rh_ = do
         _ -> Left $ ChatErrorRemoteHost rhKey' RHEBadState
       chatWriteVar currentRemoteHost $ Just remoteHostId -- this is required for commands to be passed to remote host
       toView $ CRRemoteHostConnected rhi
-    upsertRemoteHost :: ChatMonad m => RCHostPairing -> Maybe RemoteHostInfo -> Text -> m RemoteHostInfo
-    upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rhi_ hostDeviceName = do
+    upsertRemoteHost :: ChatMonad m => RCHostPairing -> Maybe RemoteHostInfo -> Text -> RemoteHostSessionState -> m RemoteHostInfo
+    upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rhi_ hostDeviceName state = do
       KnownHostPairing {hostDhPubKey = hostDhPubKey'} <- maybe (throwError . ChatError $ CEInternalError "KnownHost is known after verification") pure kh_
       case rhi_ of
         Nothing -> do
           storePath <- liftIO randomStorePath
           rh@RemoteHost {remoteHostId} <- withStore $ \db -> insertRemoteHost db hostDeviceName storePath pairing' >>= getRemoteHost db
           setNewRemoteHostId RHNew remoteHostId
-          pure $ remoteHostInfo rh True
+          pure $ remoteHostInfo rh $ Just state
         Just rhi@RemoteHostInfo {remoteHostId} -> do
           withStore' $ \db -> updateHostPairing db remoteHostId hostDeviceName hostDhPubKey'
-          pure (rhi :: RemoteHostInfo) {sessionActive = True}
+          pure (rhi :: RemoteHostInfo) {sessionState = Just state}
     onDisconnected :: ChatMonad m => RemoteHostId -> m ()
     onDisconnected remoteHostId = do
       logDebug "HTTP2 client disconnected"
@@ -225,7 +231,10 @@ closeRemoteHost rhKey = do
 cancelRemoteHost :: RemoteHostSession -> IO ()
 cancelRemoteHost = \case
   RHSessionStarting -> pure ()
-  RHSessionConnecting rhs -> cancelPendingSession rhs
+  RHSessionConnecting _inv rhs -> cancelPendingSession rhs
+  RHSessionPendingConfirmation _sessCode tls rhs -> do
+    cancelPendingSession rhs
+    closeConnection tls
   RHSessionConfirmed tls rhs -> do
     cancelPendingSession rhs
     closeConnection tls
@@ -245,26 +254,26 @@ randomStorePath = B.unpack . B64U.encode <$> getRandomBytes 12
 
 listRemoteHosts :: ChatMonad m => m [RemoteHostInfo]
 listRemoteHosts = do
-  active <- chatReadVar remoteHostSessions
-  map (rhInfo active) <$> withStore' getRemoteHosts
+  sessions <- chatReadVar remoteHostSessions
+  map (rhInfo sessions) <$> withStore' getRemoteHosts
   where
-    rhInfo active rh@RemoteHost {remoteHostId} =
-      remoteHostInfo rh (M.member (RHId remoteHostId) active)
+    rhInfo sessions rh@RemoteHost {remoteHostId} =
+      remoteHostInfo rh (rhsSessionState <$> M.lookup (RHId remoteHostId) sessions)
 
 switchRemoteHost :: ChatMonad m => Maybe RemoteHostId -> m (Maybe RemoteHostInfo)
 switchRemoteHost rhId_ = do
   rhi_ <- forM rhId_ $ \rhId -> do
     let rhKey = RHId rhId
-    rhi <- (`remoteHostInfo` True) <$> withStore (`getRemoteHost` rhId)
-    active <- chatReadVar remoteHostSessions
-    case M.lookup rhKey active of
-      Just RHSessionConnected {} -> pure rhi
+    rh <- withStore (`getRemoteHost` rhId)
+    sessions <- chatReadVar remoteHostSessions
+    case M.lookup rhKey sessions of
+      Just RHSessionConnected {} -> pure $ remoteHostInfo rh $ Just RHSConnected
       _ -> throwError $ ChatErrorRemoteHost rhKey RHEInactive
   rhi_ <$ chatWriteVar currentRemoteHost rhId_
 
-remoteHostInfo :: RemoteHost -> Bool -> RemoteHostInfo
-remoteHostInfo RemoteHost {remoteHostId, storePath, hostDeviceName} sessionActive =
-  RemoteHostInfo {remoteHostId, storePath, hostDeviceName, sessionActive}
+remoteHostInfo :: RemoteHost -> Maybe RemoteHostSessionState -> RemoteHostInfo
+remoteHostInfo RemoteHost {remoteHostId, storePath, hostDeviceName} sessionState =
+  RemoteHostInfo {remoteHostId, storePath, hostDeviceName, sessionState}
 
 deleteRemoteHost :: ChatMonad m => RemoteHostId -> m ()
 deleteRemoteHost rhId = do
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index 17ea8e159..ce2804048 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -63,7 +64,8 @@ data RHPendingSession = RHPendingSession
 
 data RemoteHostSession
   = RHSessionStarting
-  | RHSessionConnecting {rhPendingSession :: RHPendingSession}
+  | RHSessionConnecting {invitation :: Text, rhPendingSession :: RHPendingSession}
+  | RHSessionPendingConfirmation {sessionCode :: Text, tls :: TLS, rhPendingSession :: RHPendingSession}
   | RHSessionConfirmed {tls :: TLS, rhPendingSession :: RHPendingSession}
   | RHSessionConnected
     { rchClient :: RCHostClient,
@@ -73,6 +75,22 @@ data RemoteHostSession
       storePath :: FilePath
     }
 
+data RemoteHostSessionState
+  = RHSStarting
+  | RHSConnecting {invitation :: Text}
+  | RHSPendingConfirmation {sessionCode :: Text}
+  | RHSConfirmed
+  | RHSConnected
+  deriving (Show)
+
+rhsSessionState :: RemoteHostSession -> RemoteHostSessionState
+rhsSessionState = \case
+  RHSessionStarting -> RHSStarting
+  RHSessionConnecting {invitation} -> RHSConnecting {invitation}
+  RHSessionPendingConfirmation {sessionCode} -> RHSPendingConfirmation {sessionCode}
+  RHSessionConfirmed {} -> RHSConfirmed
+  RHSessionConnected {} -> RHSConnected
+
 data RemoteProtocolError
   = -- | size prefix is malformed
     RPEInvalidSize
@@ -112,7 +130,7 @@ data RemoteHostInfo = RemoteHostInfo
   { remoteHostId :: RemoteHostId,
     hostDeviceName :: Text,
     storePath :: FilePath,
-    sessionActive :: Bool
+    sessionState :: Maybe RemoteHostSessionState
   }
   deriving (Show)
 
@@ -174,6 +192,8 @@ $(J.deriveJSON (sumTypeJSON $ dropPrefix "RH") ''RHKey)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "PE") ''PlatformEncoding)
 
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "RHS") ''RemoteHostSessionState)
+
 $(J.deriveJSON defaultJSON ''RemoteHostInfo)
 
 $(J.deriveJSON defaultJSON ''RemoteCtrlInfo)
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index f3011e410..544614e23 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -1704,8 +1704,14 @@ viewRemoteHosts = \case
   [] -> ["No remote hosts"]
   hs -> "Remote hosts: " : map viewRemoteHostInfo hs
   where
-    viewRemoteHostInfo RemoteHostInfo {remoteHostId, hostDeviceName, sessionActive} =
-      plain $ tshow remoteHostId <> ". " <> hostDeviceName <> if sessionActive then " (active)" else ""
+    viewRemoteHostInfo RemoteHostInfo {remoteHostId, hostDeviceName, sessionState} =
+      plain $ tshow remoteHostId <> ". " <> hostDeviceName <> maybe "" viewSessionState sessionState
+    viewSessionState = \case
+      RHSStarting -> " (starting)"
+      RHSConnecting _ -> " (connecting)"
+      RHSPendingConfirmation {sessionCode} -> " (pending confirmation, code: " <> sessionCode <> ")"
+      RHSConfirmed -> " (confirmed)"
+      RHSConnected -> " (connected)"
 
 viewRemoteCtrls :: [RemoteCtrlInfo] -> [StyledString]
 viewRemoteCtrls = \case
@@ -1713,7 +1719,7 @@ viewRemoteCtrls = \case
   hs -> "Remote controllers: " : map viewRemoteCtrlInfo hs
   where
     viewRemoteCtrlInfo RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName, sessionActive} =
-      plain $ tshow remoteCtrlId <> ". " <> ctrlDeviceName <> if sessionActive then " (active)" else ""
+      plain $ tshow remoteCtrlId <> ". " <> ctrlDeviceName <> if sessionActive then " (connected)" else ""
 
 -- TODO fingerprint, accepted?
 viewRemoteCtrl :: RemoteCtrlInfo -> StyledString
diff --git a/stack.yaml b/stack.yaml
index 4fc46bf2b..befe0b60b 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: c051ebab74632e0eb60686329ab3fad521736f79
+    commit: e0b7942e45e36d92625e07c0c1ce9ca2375a0980
   - github: kazu-yamamoto/http2
     commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
   # - ../direct-sqlcipher
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 664797112..e3bef7f9e 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -57,11 +57,11 @@ remoteHandshakeTest viaDesktop = testChat2 aliceProfile aliceDesktopProfile $ \m
 
   desktop ##> "/list remote hosts"
   desktop <## "Remote hosts:"
-  desktop <## "1. Mobile (active)"
+  desktop <## "1. Mobile (connected)"
 
   mobile ##> "/list remote ctrls"
   mobile <## "Remote controllers:"
-  mobile <## "1. My desktop (active)"
+  mobile <## "1. My desktop (connected)"
 
   if viaDesktop then stopDesktop mobile desktop else stopMobile mobile desktop
 

From 0a4920daae4ea8f042fe227d9588d2bd22151489 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Tue, 14 Nov 2023 16:44:12 +0000
Subject: [PATCH 42/69] core: encrypt stored/loaded remote files (#3366)

* core: encrypt stored/loaded remote files

* simplexmq

* constant
---
 src/Simplex/Chat/Remote.hs           | 20 +++++++-------
 src/Simplex/Chat/Remote/Protocol.hs  | 18 ++++++-------
 src/Simplex/Chat/Remote/Transport.hs | 39 ++++++++++++++++++++++++----
 3 files changed, 52 insertions(+), 25 deletions(-)

diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index bb9610712..49c29b673 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -62,7 +62,6 @@ 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.File (hSendFile)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
 import Simplex.Messaging.Util
 import Simplex.RemoteControl.Client
@@ -399,8 +398,8 @@ handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {reque
     processCommand user getNext = \case
       RCSend {command} -> handleSend execChatCommand command >>= reply
       RCRecv {wait = time} -> handleRecv time remoteOutputQ >>= reply
-      RCStoreFile {fileName, fileSize, fileDigest} -> handleStoreFile fileName fileSize fileDigest getNext >>= reply
-      RCGetFile {file} -> handleGetFile user file replyWith
+      RCStoreFile {fileName, fileSize, fileDigest} -> handleStoreFile encryption fileName fileSize fileDigest getNext >>= reply
+      RCGetFile {file} -> handleGetFile encryption user file replyWith
     reply :: RemoteResponse -> m ()
     reply = (`replyWith` \_ -> pure ())
     replyWith :: Respond m
@@ -444,8 +443,8 @@ handleRecv time events = do
 
 -- TODO this command could remember stored files and return IDs to allow removing files that are not needed.
 -- Also, there should be some process removing unused files uploaded to remote host (possibly, all unused files).
-handleStoreFile :: forall m. ChatMonad m => FilePath -> Word32 -> FileDigest -> GetChunk -> m RemoteResponse
-handleStoreFile fileName fileSize fileDigest getChunk =
+handleStoreFile :: forall m. ChatMonad m => RemoteCrypto -> FilePath -> Word32 -> FileDigest -> GetChunk -> m RemoteResponse
+handleStoreFile encryption fileName fileSize fileDigest getChunk =
   either RRProtocolError RRFileStored <$> (chatReadVar filesFolder >>= storeFile)
   where
     storeFile :: Maybe FilePath -> m (Either RemoteProtocolError FilePath)
@@ -455,11 +454,11 @@ handleStoreFile fileName fileSize fileDigest getChunk =
     storeFileTo :: FilePath -> m (Either RemoteProtocolError FilePath)
     storeFileTo dir = liftRC . tryRemoteError $ do
       filePath <- dir `uniqueCombine` fileName
-      receiveRemoteFile getChunk fileSize fileDigest filePath
+      receiveEncryptedFile encryption getChunk fileSize fileDigest filePath
       pure filePath
 
-handleGetFile :: ChatMonad m => User -> RemoteFile -> Respond m -> m ()
-handleGetFile User {userId} RemoteFile {userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do
+handleGetFile :: ChatMonad m => RemoteCrypto -> User -> RemoteFile -> Respond m -> m ()
+handleGetFile encryption User {userId} RemoteFile {userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do
   logDebug $ "GetFile: " <> tshow filePath
   unless (userId == commandUserId) $ throwChatError $ CEDifferentActiveUser {commandUserId, activeUserId = userId}
   path <- maybe filePath (</> filePath) <$> chatReadVar filesFolder
@@ -469,8 +468,9 @@ handleGetFile User {userId} RemoteFile {userId = commandUserId, fileId, sent, fi
   liftRC (tryRemoteError $ getFileInfo path) >>= \case
     Left e -> reply (RRProtocolError e) $ \_ -> pure ()
     Right (fileSize, fileDigest) ->
-      withFile path ReadMode $ \h ->
-        reply RRFile {fileSize, fileDigest} $ \send -> hSendFile h send fileSize
+      withFile path ReadMode $ \h -> do
+        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
diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs
index eae71d09c..c1acee1e0 100644
--- a/src/Simplex/Chat/Remote/Protocol.hs
+++ b/src/Simplex/Chat/Remote/Protocol.hs
@@ -47,7 +47,6 @@ import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON, pattern SingleFi
 import Simplex.Messaging.Transport.Buffer (getBuffered)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), HTTP2BodyChunk, getBodyChunk)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2Response (..), closeHTTP2Client, sendRequestDirect)
-import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
 import Simplex.Messaging.Util (liftEitherError, liftEitherWith, liftError, tshow)
 import Simplex.RemoteControl.Types (CtrlSessKeys (..), HostSessKeys (..), RCErrorType (..), SessionCode)
 import Simplex.RemoteControl.Client (xrcpBlockSize)
@@ -127,31 +126,30 @@ remoteStoreFile c localPath fileName = do
     r -> badResponse r
 
 remoteGetFile :: RemoteHostClient -> FilePath -> RemoteFile -> ExceptT RemoteProtocolError IO ()
-remoteGetFile c destDir rf@RemoteFile {fileSource = CryptoFile {filePath}} =
+remoteGetFile c@RemoteHostClient{encryption} destDir rf@RemoteFile {fileSource = CryptoFile {filePath}} =
   sendRemoteCommand c Nothing RCGetFile {file = rf} >>= \case
     (getChunk, RRFile {fileSize, fileDigest}) -> do
       -- TODO we could optimize by checking size and hash before receiving the file
       let localPath = destDir </> takeFileName filePath
-      receiveRemoteFile getChunk fileSize fileDigest localPath
+      receiveEncryptedFile encryption getChunk fileSize fileDigest localPath
     (_, r) -> badResponse r
 
--- TODO validate there is no attachment
+-- TODO validate there is no attachment in response
 sendRemoteCommand' :: RemoteHostClient -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO RemoteResponse
 sendRemoteCommand' c attachment_ rc = snd <$> sendRemoteCommand c attachment_ rc
 
 sendRemoteCommand :: RemoteHostClient -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO (Int -> IO ByteString, RemoteResponse)
-sendRemoteCommand RemoteHostClient {httpClient, hostEncoding, encryption} attachment_ cmd = do
-  req <- httpRequest <$> encryptEncodeHTTP2Body encryption (J.encode cmd)
+sendRemoteCommand RemoteHostClient {httpClient, hostEncoding, encryption} file_ cmd = do
+  encFile_ <- mapM (prepareEncryptedFile encryption) file_ 
+  req <- httpRequest encFile_ <$> encryptEncodeHTTP2Body encryption (J.encode cmd)
   HTTP2Response {response, respBody} <- liftEitherError (RPEHTTP2 . tshow) $ sendRequestDirect httpClient req Nothing
   (header, getNext) <- parseDecryptHTTP2Body encryption response respBody
   rr <- liftEitherWith (RPEInvalidJSON . fromString) $ J.eitherDecode header >>= JT.parseEither J.parseJSON . convertJSON hostEncoding localEncoding
   pure (getNext, rr)
   where
-    httpRequest cmdBld = H.requestStreaming N.methodPost "/" mempty $ \send flush -> do
+    httpRequest encFile_ cmdBld = H.requestStreaming N.methodPost "/" mempty $ \send flush -> do
       send cmdBld
-      case attachment_ of
-        Nothing -> pure ()
-        Just (h, sz) -> hSendFile h send sz
+      forM_ encFile_ (`sendEncryptedFile` send)
       flush
 
 badResponse :: RemoteResponse -> ExceptT RemoteProtocolError IO a
diff --git a/src/Simplex/Chat/Remote/Transport.hs b/src/Simplex/Chat/Remote/Transport.hs
index bf798444c..c5ddfbdb8 100644
--- a/src/Simplex/Chat/Remote/Transport.hs
+++ b/src/Simplex/Chat/Remote/Transport.hs
@@ -1,23 +1,52 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Simplex.Chat.Remote.Transport where
 
 import Control.Monad
 import Control.Monad.Except
+import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as LB
 import Data.Word (Word32)
 import Simplex.FileTransfer.Description (FileDigest (..))
 import Simplex.Chat.Remote.Types
+import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
-import Simplex.Messaging.Transport.HTTP2.File (hReceiveFile)
+import Simplex.FileTransfer.Transport (ReceiveFileError (..), receiveSbFile, sendEncFile)
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Util (liftEitherError, liftEitherWith)
+import Simplex.RemoteControl.Types (RCErrorType (..))
 import UnliftIO
 import UnliftIO.Directory (getFileSize)
 
-receiveRemoteFile :: (Int -> IO ByteString) -> Word32 -> FileDigest -> FilePath -> ExceptT RemoteProtocolError IO ()
-receiveRemoteFile getChunk fileSize fileDigest toPath = do
-  diff <- liftIO $ withFile toPath WriteMode $ \h -> hReceiveFile getChunk h fileSize
-  unless (diff == 0) $ throwError RPEFileSize
+type EncryptedFile = ((Handle, Word32), C.CbNonce, LC.SbState)
+
+prepareEncryptedFile :: RemoteCrypto -> (Handle, Word32) -> ExceptT RemoteProtocolError IO EncryptedFile
+prepareEncryptedFile RemoteCrypto {drg, hybridKey} f = do
+  nonce <- atomically $ C.pseudoRandomCbNonce drg
+  sbState <- liftEitherWith (const $ PRERemoteControl RCEEncrypt) $ LC.kcbInit hybridKey nonce
+  pure (f, nonce, sbState)
+
+sendEncryptedFile :: EncryptedFile -> (Builder -> IO ()) -> IO ()
+sendEncryptedFile ((h, sz), nonce, sbState) send = do
+  send $ byteString $ smpEncode ('\x01', nonce, sz + fromIntegral C.authTagSize)
+  sendEncFile h send sbState sz
+
+receiveEncryptedFile :: RemoteCrypto -> (Int -> IO ByteString) -> Word32 -> FileDigest -> FilePath -> ExceptT RemoteProtocolError IO ()
+receiveEncryptedFile RemoteCrypto {hybridKey} getChunk fileSize fileDigest toPath = do
+  c <- liftIO $ getChunk 1
+  unless (c == "\x01") $ throwError RPENoFile
+  nonce <- liftEitherError RPEInvalidBody $ smpDecode <$> getChunk 24
+  size <- liftEitherError RPEInvalidBody $ smpDecode <$> getChunk 4
+  unless (size == fileSize + fromIntegral C.authTagSize) $ throwError RPEFileSize
+  sbState <- liftEitherWith (const $ PRERemoteControl RCEDecrypt) $ LC.kcbInit hybridKey nonce
+  liftEitherError fErr $ withFile toPath WriteMode $ \h -> receiveSbFile getChunk h sbState fileSize
   digest <- liftIO $ LC.sha512Hash <$> LB.readFile toPath
   unless (FileDigest digest == fileDigest) $ throwError RPEFileDigest
+  where
+    fErr RFESize = RPEFileSize
+    fErr RFECrypto = PRERemoteControl RCEDecrypt
 
 getFileInfo :: FilePath -> ExceptT RemoteProtocolError IO (Word32, FileDigest)
 getFileInfo filePath = do

From d4ba1bbe6966edda2e170f2a585d3d1fbbea1b1c Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Tue, 14 Nov 2023 22:27:21 +0000
Subject: [PATCH 43/69] core: update remote host session state (#3371)

---
 src/Simplex/Chat/Remote.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 49c29b673..32ffaee91 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -170,7 +170,9 @@ startRemoteHost rh_ = do
       withRemoteHostSession rhKey $ \case
         RHSessionConnecting _inv rhs' -> Right ((), RHSessionPendingConfirmation sessCode tls rhs') -- TODO check it's the same session?
         _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
-      toView $ CRRemoteHostSessionCode {remoteHost_, sessionCode = verificationCode sessId} -- display confirmation code, wait for mobile to confirm
+      -- display confirmation code, wait for mobile to confirm
+      let rh_' = (\rh -> rh {sessionState = Just $ RHSPendingConfirmation sessCode}) <$> remoteHost_
+      toView $ CRRemoteHostSessionCode {remoteHost_ = rh_', sessionCode = verificationCode sessId}
       (RCHostSession {sessionKeys}, rhHello, pairing') <- takeRCStep vars' -- no timeout, waiting for user to compare the code
       hostInfo@HostAppInfo {deviceName = hostDeviceName} <-
         liftError (ChatErrorRemoteHost rhKey) $ parseHostAppInfo rhHello
@@ -178,7 +180,7 @@ startRemoteHost rh_ = do
         RHSessionPendingConfirmation _ tls' rhs' -> Right ((), RHSessionConfirmed tls' rhs') -- TODO check it's the same session?
         _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
       -- update remoteHost with updated pairing
-      rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' remoteHost_ hostDeviceName RHSConfirmed
+      rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' rh_' hostDeviceName RHSConfirmed
       let rhKey' = RHId remoteHostId -- rhKey may be invalid after upserting on RHNew
       when (rhKey' /= rhKey) $ do
         atomically $ writeTVar rhKeyVar rhKey'
@@ -191,7 +193,7 @@ startRemoteHost rh_ = do
         RHSessionConfirmed _ RHPendingSession {rchClient} -> Right ((), RHSessionConnected {rchClient, tls, rhClient, pollAction, storePath})
         _ -> Left $ ChatErrorRemoteHost rhKey' RHEBadState
       chatWriteVar currentRemoteHost $ Just remoteHostId -- this is required for commands to be passed to remote host
-      toView $ CRRemoteHostConnected rhi
+      toView $ CRRemoteHostConnected rhi {sessionState = Just RHSConnected}
     upsertRemoteHost :: ChatMonad m => RCHostPairing -> Maybe RemoteHostInfo -> Text -> RemoteHostSessionState -> m RemoteHostInfo
     upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rhi_ hostDeviceName state = do
       KnownHostPairing {hostDhPubKey = hostDhPubKey'} <- maybe (throwError . ChatError $ CEInternalError "KnownHost is known after verification") pure kh_

From 3d617bce25dd0bf9471c13e96d3e5a8680806a27 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Tue, 14 Nov 2023 22:40:15 +0000
Subject: [PATCH 44/69] core: test JSON conversion (#3370)

---
 src/Simplex/Chat/Controller.hs |  2 +-
 tests/JSONTests.hs             | 35 +++++++++++++++++++++++++++-------
 2 files changed, 29 insertions(+), 8 deletions(-)

diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 622ce7b70..3144c909d 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -1200,7 +1200,7 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CP") ''ConnectionPlan)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CE") ''ChatErrorType)
 
-$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RH") ''RemoteHostError)
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RHE") ''RemoteHostError)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCE") ''RemoteCtrlError)
 
diff --git a/tests/JSONTests.hs b/tests/JSONTests.hs
index 188fe2759..a17a69fae 100644
--- a/tests/JSONTests.hs
+++ b/tests/JSONTests.hs
@@ -1,10 +1,14 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module JSONTests where
 
+import Control.Monad (join)
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
 import qualified Data.Aeson.Types as JT
+import Data.ByteString.Builder (toLazyByteString)
 import qualified Data.ByteString.Lazy.Char8 as LB
 import GHC.Generics (Generic)
 import Generic.Random (genericArbitraryU)
@@ -15,11 +19,6 @@ import Test.Hspec
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
 import Test.QuickCheck (Arbitrary (..), property)
 
-jsonTests :: Spec
-jsonTests = describe "owsf2tagged" $ do
-  it "should convert chat types" owsf2TaggedJSONTest
-  describe "SomeType" owsf2TaggedSomeTypeTests
-
 owsf2TaggedJSONTest :: IO ()
 owsf2TaggedJSONTest = do
   noActiveUserSwift `to` noActiveUserTagged
@@ -50,6 +49,17 @@ data SomeType
   | List [Int]
   deriving (Eq, Show, Generic)
 
+$(pure [])
+
+thToJSON :: SomeType -> J.Value
+thToJSON = $(JQ.mkToJSON (singleFieldJSON_ (Just SingleFieldJSONTag) id) ''SomeType)
+
+thToEncoding :: SomeType -> J.Encoding
+thToEncoding = $(JQ.mkToEncoding (singleFieldJSON_ (Just SingleFieldJSONTag) id) ''SomeType)
+
+thParseJSON :: J.Value -> JT.Parser SomeType
+thParseJSON = $(JQ.mkParseJSON (taggedObjectJSON id) ''SomeType)
+
 instance Arbitrary SomeType where arbitrary = genericArbitraryU
 
 instance ToJSON SomeType where
@@ -60,6 +70,17 @@ instance FromJSON SomeType where
   parseJSON = J.genericParseJSON $ taggedObjectJSON id
 
 owsf2TaggedSomeTypeTests :: Spec
-owsf2TaggedSomeTypeTests =
-  modifyMaxSuccess (const 10000) $ it "should convert to tagged" $ property $ \x ->
+owsf2TaggedSomeTypeTests = modifyMaxSuccess (const 10000) $ do
+  it "should convert to tagged" $ property $ \x ->
     (JT.parseMaybe J.parseJSON . owsf2tagged . J.toJSON) x == Just (x :: SomeType)
+  it "should convert to tagged via encoding" $ property $ \x ->
+    (join . fmap (JT.parseMaybe J.parseJSON . owsf2tagged) . J.decode . J.encode) x == Just (x :: SomeType)
+  it "should convert to tagged via TH" $ property $ \x ->
+    (JT.parseMaybe thParseJSON . owsf2tagged . thToJSON) x == Just (x :: SomeType)
+  it "should convert to tagged via TH encoding" $ property $ \x ->
+    (join . fmap (JT.parseMaybe thParseJSON . owsf2tagged) . J.decode . toLazyByteString . J.fromEncoding . thToEncoding) x == Just (x :: SomeType)
+
+jsonTests :: Spec
+jsonTests = describe "owsf2tagged" $ do
+  it "should convert chat types" owsf2TaggedJSONTest
+  describe "SomeType" owsf2TaggedSomeTypeTests

From fa9d61caa4ec4633e843d7c0d9540818b7c38a37 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Wed, 15 Nov 2023 15:09:52 +0200
Subject: [PATCH 45/69] remove host store in deleteRemoteHost (#3373)

---
 src/Simplex/Chat/Remote.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 32ffaee91..05183c1d8 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -70,7 +70,7 @@ import Simplex.RemoteControl.Types
 import System.FilePath (takeFileName, (</>))
 import UnliftIO
 import UnliftIO.Concurrent (forkIO)
-import UnliftIO.Directory (copyFile, createDirectoryIfMissing, renameFile)
+import UnliftIO.Directory (copyFile, createDirectoryIfMissing, removeDirectoryRecursive, renameFile)
 
 -- when acting as host
 minRemoteCtrlVersion :: AppVersion
@@ -282,7 +282,8 @@ deleteRemoteHost rhId = do
   chatReadVar filesFolder >>= \case
     Just baseDir -> do
       let hostStore = baseDir </> storePath
-      logError $ "TODO: remove " <> tshow hostStore
+      logInfo $ "removing host store at " <> tshow hostStore
+      removeDirectoryRecursive $ hostStore
     Nothing -> logWarn "Local file store not available while deleting remote host"
   withStore' (`deleteRemoteHostRecord` rhId)
 

From b71daed3ec02cc139d2639fc2cf821fdad8ac588 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Wed, 15 Nov 2023 13:17:31 +0000
Subject: [PATCH 46/69] core: include session code in all session states
 (#3374)

---
 src/Simplex/Chat.hs              |  3 +-
 src/Simplex/Chat/Controller.hs   | 32 ++++++++++++++++++--
 src/Simplex/Chat/Remote.hs       | 52 ++++++++++++++++++--------------
 src/Simplex/Chat/Remote/Types.hs | 27 ++++++++---------
 src/Simplex/Chat/View.hs         | 13 +++++---
 5 files changed, 82 insertions(+), 45 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 619f93b89..b6b7cca1a 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1967,8 +1967,7 @@ 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
-    (rc_, ctrlAppInfo) <- connectRemoteCtrl inv
-    let remoteCtrl_ = (`remoteCtrlInfo` True) <$> rc_
+    (remoteCtrl_, ctrlAppInfo) <- connectRemoteCtrl inv
     pure CRRemoteCtrlConnecting {remoteCtrl_, ctrlAppInfo, appVersion = currentAppVersion}
   FindKnownRemoteCtrl -> withUser_ $ findKnownRemoteCtrl >> ok_
   ConfirmRemoteCtrl rc -> withUser_ $ confirmRemoteCtrl rc >> ok_
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 3144c909d..fb03844f8 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -1077,11 +1077,13 @@ data ArchiveError
 data RemoteCtrlSession
   = RCSessionStarting
   | RCSessionConnecting
-      { rcsClient :: RCCtrlClient,
+      { remoteCtrlId_ :: Maybe RemoteCtrlId,
+        rcsClient :: RCCtrlClient,
         rcsWaitSession :: Async ()
       }
   | RCSessionPendingConfirmation
-      { ctrlDeviceName :: Text,
+      { remoteCtrlId_ :: Maybe RemoteCtrlId,
+        ctrlDeviceName :: Text,
         rcsClient :: RCCtrlClient,
         tls :: TLS,
         sessionCode :: Text,
@@ -1097,6 +1099,28 @@ data RemoteCtrlSession
         remoteOutputQ :: TBQueue ChatResponse
       }
 
+data RemoteCtrlSessionState
+  = RCSStarting
+  | RCSConnecting
+  | RCSPendingConfirmation {sessionCode :: Text}
+  | RCSConnected {sessionCode :: Text}
+  deriving (Show)
+
+rcsSessionState :: RemoteCtrlSession -> RemoteCtrlSessionState
+rcsSessionState = \case
+  RCSessionStarting -> RCSStarting
+  RCSessionConnecting {} -> RCSConnecting
+  RCSessionPendingConfirmation {tls} -> RCSPendingConfirmation {sessionCode = tlsSessionCode tls}
+  RCSessionConnected {tls} -> RCSConnected {sessionCode = tlsSessionCode tls}
+
+-- | UI-accessible remote controller information
+data RemoteCtrlInfo = RemoteCtrlInfo
+  { remoteCtrlId :: RemoteCtrlId,
+    ctrlDeviceName :: Text,
+    sessionState :: Maybe RemoteCtrlSessionState
+  }
+  deriving (Show)
+
 type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m)
 
 type ChatMonad m = (ChatMonad' m, MonadError ChatError m)
@@ -1259,6 +1283,10 @@ instance ToJSON AUserProtoServers where
   toJSON (AUPS s) = $(JQ.mkToJSON defaultJSON ''UserProtoServers) s
   toEncoding (AUPS s) = $(JQ.mkToEncoding defaultJSON ''UserProtoServers) s
 
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCS") ''RemoteCtrlSessionState)
+
+$(JQ.deriveJSON defaultJSON ''RemoteCtrlInfo)
+
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CR") ''ChatResponse)
 
 $(JQ.deriveFromJSON defaultJSON ''ArchiveConfig)
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 05183c1d8..16044ee92 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -166,13 +166,13 @@ startRemoteHost rh_ = do
     waitForHostSession :: ChatMonad m => Maybe RemoteHostInfo -> RHKey -> TVar RHKey -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
     waitForHostSession remoteHost_ rhKey rhKeyVar vars = do
       (sessId, tls, vars') <- takeRCStep vars -- no timeout, waiting for user to scan invite
-      let sessCode = verificationCode sessId
+      let sessionCode = verificationCode sessId
       withRemoteHostSession rhKey $ \case
-        RHSessionConnecting _inv rhs' -> Right ((), RHSessionPendingConfirmation sessCode tls rhs') -- TODO check it's the same session?
+        RHSessionConnecting _inv rhs' -> Right ((), RHSessionPendingConfirmation sessionCode tls rhs') -- TODO check it's the same session?
         _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
       -- display confirmation code, wait for mobile to confirm
-      let rh_' = (\rh -> rh {sessionState = Just $ RHSPendingConfirmation sessCode}) <$> remoteHost_
-      toView $ CRRemoteHostSessionCode {remoteHost_ = rh_', sessionCode = verificationCode sessId}
+      let rh_' = (\rh -> (rh :: RemoteHostInfo) {sessionState = Just $ RHSPendingConfirmation {sessionCode}}) <$> remoteHost_
+      toView $ CRRemoteHostSessionCode {remoteHost_ = rh_', sessionCode}
       (RCHostSession {sessionKeys}, rhHello, pairing') <- takeRCStep vars' -- no timeout, waiting for user to compare the code
       hostInfo@HostAppInfo {deviceName = hostDeviceName} <-
         liftError (ChatErrorRemoteHost rhKey) $ parseHostAppInfo rhHello
@@ -180,7 +180,7 @@ startRemoteHost rh_ = do
         RHSessionPendingConfirmation _ tls' rhs' -> Right ((), RHSessionConfirmed tls' rhs') -- TODO check it's the same session?
         _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
       -- update remoteHost with updated pairing
-      rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' rh_' hostDeviceName RHSConfirmed
+      rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' rh_' hostDeviceName RHSConfirmed {sessionCode}
       let rhKey' = RHId remoteHostId -- rhKey may be invalid after upserting on RHNew
       when (rhKey' /= rhKey) $ do
         atomically $ writeTVar rhKeyVar rhKey'
@@ -193,7 +193,7 @@ startRemoteHost rh_ = do
         RHSessionConfirmed _ RHPendingSession {rchClient} -> Right ((), RHSessionConnected {rchClient, tls, rhClient, pollAction, storePath})
         _ -> Left $ ChatErrorRemoteHost rhKey' RHEBadState
       chatWriteVar currentRemoteHost $ Just remoteHostId -- this is required for commands to be passed to remote host
-      toView $ CRRemoteHostConnected rhi {sessionState = Just RHSConnected}
+      toView $ CRRemoteHostConnected rhi {sessionState = Just RHSConnected {sessionCode}}
     upsertRemoteHost :: ChatMonad m => RCHostPairing -> Maybe RemoteHostInfo -> Text -> RemoteHostSessionState -> m RemoteHostInfo
     upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rhi_ hostDeviceName state = do
       KnownHostPairing {hostDhPubKey = hostDhPubKey'} <- maybe (throwError . ChatError $ CEInternalError "KnownHost is known after verification") pure kh_
@@ -268,7 +268,7 @@ switchRemoteHost rhId_ = do
     rh <- withStore (`getRemoteHost` rhId)
     sessions <- chatReadVar remoteHostSessions
     case M.lookup rhKey sessions of
-      Just RHSessionConnected {} -> pure $ remoteHostInfo rh $ Just RHSConnected
+      Just RHSessionConnected {tls} -> pure $ remoteHostInfo rh $ Just RHSConnected {sessionCode = tlsSessionCode tls}
       _ -> throwError $ ChatErrorRemoteHost rhKey RHEInactive
   rhi_ <$ chatWriteVar currentRemoteHost rhId_
 
@@ -341,7 +341,7 @@ findKnownRemoteCtrl :: ChatMonad m => m ()
 findKnownRemoteCtrl = undefined -- do
 
 -- | Use provided OOB link as an annouce
-connectRemoteCtrl :: ChatMonad m => RCSignedInvitation -> m (Maybe RemoteCtrl, CtrlAppInfo)
+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
   withRemoteCtrlSession_ $ maybe (Right ((), Just RCSessionStarting)) (\_ -> Left $ ChatErrorRemoteCtrl RCEBusy)
@@ -355,10 +355,10 @@ connectRemoteCtrl signedInv@RCSignedInvitation {invitation = inv@RCInvitation {c
     atomically $ takeTMVar cmdOk
     handleCtrlError "waitForCtrlSession" $ waitForCtrlSession rc_ ctrlDeviceName rcsClient vars
   updateRemoteCtrlSession $ \case
-    RCSessionStarting -> Right RCSessionConnecting {rcsClient, rcsWaitSession}
+    RCSessionStarting -> Right RCSessionConnecting {remoteCtrlId_ = remoteCtrlId' <$> rc_, rcsClient, rcsWaitSession}
     _ -> Left $ ChatErrorRemoteCtrl RCEBadState
   atomically $ putTMVar cmdOk ()
-  pure (rc_, ctrlInfo)
+  pure ((`remoteCtrlInfo` Just RCSConnecting) <$> rc_, ctrlInfo)
   where
     validateRemoteCtrl RCInvitation {idkey} RemoteCtrl {ctrlPairing = RCCtrlPairing {idPubKey}} =
       unless (idkey == idPubKey) $ throwError $ ChatErrorRemoteCtrl $ RCEProtocolError $ PRERemoteControl RCEIdentity
@@ -366,10 +366,12 @@ connectRemoteCtrl signedInv@RCSignedInvitation {invitation = inv@RCInvitation {c
     waitForCtrlSession rc_ ctrlName rcsClient vars = do
       (uniq, tls, rcsWaitConfirmation) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout $ takeRCStep vars
       let sessionCode = verificationCode uniq
-      toView CRRemoteCtrlSessionCode {remoteCtrl_ = (`remoteCtrlInfo` True) <$> rc_, sessionCode}
       updateRemoteCtrlSession $ \case
-        RCSessionConnecting {rcsWaitSession} -> Right RCSessionPendingConfirmation {ctrlDeviceName = ctrlName, rcsClient, tls, sessionCode, rcsWaitSession, rcsWaitConfirmation}
+        RCSessionConnecting {rcsWaitSession} ->
+          let remoteCtrlId_ = remoteCtrlId' <$> rc_
+           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
@@ -481,17 +483,23 @@ discoverRemoteCtrls discovered = do
 
 listRemoteCtrls :: ChatMonad m => m [RemoteCtrlInfo]
 listRemoteCtrls = do
-  active <- chatReadVar remoteCtrlSession >>= \case
-    Just RCSessionConnected {remoteCtrlId} -> pure $ Just remoteCtrlId
-    _ -> pure Nothing
-  map (rcInfo active) <$> withStore' getRemoteCtrls
+  session <- chatReadVar remoteCtrlSession
+  let rcId = sessionRcId =<< session
+      sessState = rcsSessionState <$> session
+  map (rcInfo rcId sessState) <$> withStore' getRemoteCtrls
   where
-    rcInfo activeRcId rc@RemoteCtrl {remoteCtrlId} =
-      remoteCtrlInfo rc $ activeRcId == Just remoteCtrlId
+    rcInfo :: Maybe RemoteCtrlId -> Maybe RemoteCtrlSessionState -> RemoteCtrl -> RemoteCtrlInfo
+    rcInfo rcId sessState rc@RemoteCtrl {remoteCtrlId} =
+      remoteCtrlInfo rc $ if rcId == Just remoteCtrlId then sessState else Nothing
+    sessionRcId = \case
+      RCSessionConnecting {remoteCtrlId_} -> remoteCtrlId_
+      RCSessionPendingConfirmation {remoteCtrlId_} -> remoteCtrlId_
+      RCSessionConnected {remoteCtrlId} -> Just remoteCtrlId
+      _ -> Nothing
 
-remoteCtrlInfo :: RemoteCtrl -> Bool -> RemoteCtrlInfo
-remoteCtrlInfo RemoteCtrl {remoteCtrlId, ctrlDeviceName} sessionActive =
-  RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName, sessionActive}
+remoteCtrlInfo :: RemoteCtrl -> Maybe RemoteCtrlSessionState -> RemoteCtrlInfo
+remoteCtrlInfo RemoteCtrl {remoteCtrlId, ctrlDeviceName} sessionState =
+  RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName, sessionState}
 
 -- XXX: only used for multicast
 confirmRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
@@ -521,7 +529,7 @@ verifyRemoteCtrlSession execChatCommand sessCode' = handleCtrlError "verifyRemot
   withRemoteCtrlSession $ \case
     RCSessionPendingConfirmation {} -> Right ((), RCSessionConnected {remoteCtrlId, rcsClient = client, rcsSession, tls, http2Server, remoteOutputQ})
     _ -> Left $ ChatErrorRemoteCtrl RCEBadState
-  pure $ remoteCtrlInfo rc True
+  pure $ remoteCtrlInfo rc $ Just RCSConnected {sessionCode = tlsSessionCode tls}
   where
     upsertRemoteCtrl :: ChatMonad m => Text -> RCCtrlPairing -> m RemoteCtrl
     upsertRemoteCtrl ctrlName rcCtrlPairing = withStore $ \db -> do
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index ce2804048..c56b2462b 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -19,6 +19,7 @@ import Data.ByteString (ByteString)
 import Data.Int (Int64)
 import Data.Text (Text)
 import Simplex.Chat.Remote.AppVersion
+import Simplex.Chat.Types (verificationCode)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.SNTRUP761 (KEMHybridSecret)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
@@ -26,7 +27,7 @@ import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import Simplex.RemoteControl.Client
 import Simplex.RemoteControl.Types
 import Simplex.Messaging.Crypto.File (CryptoFile)
-import Simplex.Messaging.Transport (TLS)
+import Simplex.Messaging.Transport (TLS (..))
 
 data RemoteHostClient = RemoteHostClient
   { hostEncoding :: PlatformEncoding,
@@ -79,17 +80,20 @@ data RemoteHostSessionState
   = RHSStarting
   | RHSConnecting {invitation :: Text}
   | RHSPendingConfirmation {sessionCode :: Text}
-  | RHSConfirmed
-  | RHSConnected
+  | RHSConfirmed {sessionCode :: Text}
+  | RHSConnected {sessionCode :: Text}
   deriving (Show)
 
 rhsSessionState :: RemoteHostSession -> RemoteHostSessionState
 rhsSessionState = \case
   RHSessionStarting -> RHSStarting
   RHSessionConnecting {invitation} -> RHSConnecting {invitation}
-  RHSessionPendingConfirmation {sessionCode} -> RHSPendingConfirmation {sessionCode}
-  RHSessionConfirmed {} -> RHSConfirmed
-  RHSessionConnected {} -> RHSConnected
+  RHSessionPendingConfirmation {tls} -> RHSPendingConfirmation {sessionCode = tlsSessionCode tls}
+  RHSessionConfirmed {tls} -> RHSConfirmed {sessionCode = tlsSessionCode tls}
+  RHSessionConnected {tls} -> RHSConnected {sessionCode = tlsSessionCode tls}
+
+tlsSessionCode :: TLS -> Text
+tlsSessionCode = verificationCode . tlsUniq
 
 data RemoteProtocolError
   = -- | size prefix is malformed
@@ -143,13 +147,8 @@ data RemoteCtrl = RemoteCtrl
     ctrlPairing :: RCCtrlPairing
   }
 
--- | UI-accessible remote controller information
-data RemoteCtrlInfo = RemoteCtrlInfo
-  { remoteCtrlId :: RemoteCtrlId,
-    ctrlDeviceName :: Text,
-    sessionActive :: Bool
-  }
-  deriving (Show)
+remoteCtrlId' :: RemoteCtrl -> RemoteCtrlId
+remoteCtrlId' = remoteCtrlId
 
 data PlatformEncoding
   = PESwift
@@ -196,8 +195,6 @@ $(J.deriveJSON (sumTypeJSON $ dropPrefix "RHS") ''RemoteHostSessionState)
 
 $(J.deriveJSON defaultJSON ''RemoteHostInfo)
 
-$(J.deriveJSON defaultJSON ''RemoteCtrlInfo)
-
 $(J.deriveJSON defaultJSON ''CtrlAppInfo)
 
 $(J.deriveJSON defaultJSON ''HostAppInfo)
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 544614e23..98a3edd47 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -1710,16 +1710,21 @@ viewRemoteHosts = \case
       RHSStarting -> " (starting)"
       RHSConnecting _ -> " (connecting)"
       RHSPendingConfirmation {sessionCode} -> " (pending confirmation, code: " <> sessionCode <> ")"
-      RHSConfirmed -> " (confirmed)"
-      RHSConnected -> " (connected)"
+      RHSConfirmed _ -> " (confirmed)"
+      RHSConnected _ -> " (connected)"
 
 viewRemoteCtrls :: [RemoteCtrlInfo] -> [StyledString]
 viewRemoteCtrls = \case
   [] -> ["No remote controllers"]
   hs -> "Remote controllers: " : map viewRemoteCtrlInfo hs
   where
-    viewRemoteCtrlInfo RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName, sessionActive} =
-      plain $ tshow remoteCtrlId <> ". " <> ctrlDeviceName <> if sessionActive then " (connected)" else ""
+    viewRemoteCtrlInfo RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName, sessionState} =
+      plain $ tshow remoteCtrlId <> ". " <> ctrlDeviceName <> maybe "" viewSessionState sessionState
+    viewSessionState = \case
+      RCSStarting -> " (starting)"
+      RCSConnecting -> " (connecting)"
+      RCSPendingConfirmation {sessionCode} -> " (pending confirmation, code: " <> sessionCode <> ")"
+      RCSConnected _ -> " (connected)"
 
 -- TODO fingerprint, accepted?
 viewRemoteCtrl :: RemoteCtrlInfo -> StyledString

From a75fce8dfa30e86a9b61c175ca1db04e49fcb77f Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Wed, 15 Nov 2023 17:57:29 +0200
Subject: [PATCH 47/69] Fix hostStore path and check before removing (#3375)

---
 src/Simplex/Chat/Remote.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 16044ee92..b3d2d0ebf 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -70,7 +70,7 @@ import Simplex.RemoteControl.Types
 import System.FilePath (takeFileName, (</>))
 import UnliftIO
 import UnliftIO.Concurrent (forkIO)
-import UnliftIO.Directory (copyFile, createDirectoryIfMissing, removeDirectoryRecursive, renameFile)
+import UnliftIO.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, removeDirectoryRecursive, renameFile)
 
 -- when acting as host
 minRemoteCtrlVersion :: AppVersion
@@ -279,11 +279,11 @@ remoteHostInfo RemoteHost {remoteHostId, storePath, hostDeviceName} sessionState
 deleteRemoteHost :: ChatMonad m => RemoteHostId -> m ()
 deleteRemoteHost rhId = do
   RemoteHost {storePath} <- withStore (`getRemoteHost` rhId)
-  chatReadVar filesFolder >>= \case
+  chatReadVar remoteHostsFolder >>= \case
     Just baseDir -> do
       let hostStore = baseDir </> storePath
       logInfo $ "removing host store at " <> tshow hostStore
-      removeDirectoryRecursive $ hostStore
+      whenM (doesDirectoryExist hostStore) $ removeDirectoryRecursive hostStore
     Nothing -> logWarn "Local file store not available while deleting remote host"
   withStore' (`deleteRemoteHostRecord` rhId)
 

From 339c3d2be187c843ab63a0eb519c04ed987d271c Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Wed, 15 Nov 2023 19:31:36 +0200
Subject: [PATCH 48/69] Send CRRemote*Stopped on all errors (#3376)

* Send CRRemote*Stopped on all errors

Commands use the same action, made idempotent and don't send events.

* fix tests

* get http2 cancelling back
---
 src/Simplex/Chat.hs            |  2 +-
 src/Simplex/Chat/Controller.hs |  2 +-
 src/Simplex/Chat/Remote.hs     | 64 +++++++++++++++++++---------------
 src/Simplex/Chat/View.hs       |  4 ++-
 tests/RemoteTests.hs           | 20 +++--------
 5 files changed, 45 insertions(+), 47 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index b6b7cca1a..ea16785e4 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -375,7 +375,7 @@ restoreCalls = do
 
 stopChatController :: forall m. MonadUnliftIO m => ChatController -> m ()
 stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags, remoteHostSessions, remoteCtrlSession} = do
-  readTVarIO remoteHostSessions >>= mapM_ (liftIO . cancelRemoteHost)
+  readTVarIO remoteHostSessions >>= mapM_ (liftIO . cancelRemoteHost True)
   atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl)
   disconnectAgentClient smpAgent
   readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2)
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index fb03844f8..68d909f78 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -647,7 +647,7 @@ data ChatResponse
   | CRRemoteHostSessionCode {remoteHost_ :: Maybe RemoteHostInfo, sessionCode :: Text}
   | CRNewRemoteHost {remoteHost :: RemoteHostInfo}
   | CRRemoteHostConnected {remoteHost :: RemoteHostInfo}
-  | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
+  | CRRemoteHostStopped {remoteHostId_ :: Maybe RemoteHostId}
   | CRRemoteFileStored {remoteHostId :: RemoteHostId, remoteFileSource :: CryptoFile}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrlInfo} -- registered fingerprint, may connect
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index b3d2d0ebf..23d74404d 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -157,12 +157,9 @@ startRemoteHost rh_ = do
       when (encoding == PEKotlin && localEncoding == PESwift) $ throwError $ RHEProtocolError RPEIncompatibleEncoding
       pure hostInfo
     handleHostError :: ChatMonad m => TVar RHKey -> m () -> m ()
-    handleHostError rhKeyVar action = do
-      action `catchChatError` \err -> do
-        logError $ "startRemoteHost.waitForHostSession crashed: " <> tshow err
-        sessions <- asks remoteHostSessions
-        session_ <- atomically $ readTVar rhKeyVar >>= (`TM.lookupDelete` sessions)
-        mapM_ (liftIO . cancelRemoteHost) session_
+    handleHostError rhKeyVar action = action `catchChatError` \err -> do
+      logError $ "startRemoteHost.waitForHostSession crashed: " <> tshow err
+      readTVarIO rhKeyVar >>= cancelRemoteHostSession True True
     waitForHostSession :: ChatMonad m => Maybe RemoteHostInfo -> RHKey -> TVar RHKey -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
     waitForHostSession remoteHost_ rhKey rhKeyVar vars = do
       (sessId, tls, vars') <- takeRCStep vars -- no timeout, waiting for user to scan invite
@@ -185,7 +182,7 @@ startRemoteHost rh_ = do
       when (rhKey' /= rhKey) $ do
         atomically $ writeTVar rhKeyVar rhKey'
         toView $ CRNewRemoteHost rhi
-      disconnected <- toIO $ onDisconnected remoteHostId
+      disconnected <- toIO $ onDisconnected rhKey'
       httpClient <- liftEitherError (httpError rhKey') $ attachRevHTTP2Client disconnected tls
       rhClient <- mkRemoteHostClient httpClient sessionKeys sessId storePath hostInfo
       pollAction <- async $ pollEvents remoteHostId rhClient
@@ -206,13 +203,10 @@ startRemoteHost rh_ = do
         Just rhi@RemoteHostInfo {remoteHostId} -> do
           withStore' $ \db -> updateHostPairing db remoteHostId hostDeviceName hostDhPubKey'
           pure (rhi :: RemoteHostInfo) {sessionState = Just state}
-    onDisconnected :: ChatMonad m => RemoteHostId -> m ()
-    onDisconnected remoteHostId = do
+    onDisconnected :: ChatMonad m => RHKey -> m ()
+    onDisconnected rhKey = do
       logDebug "HTTP2 client disconnected"
-      chatModifyVar currentRemoteHost $ \cur -> if cur == Just remoteHostId then Nothing else cur -- only wipe the closing RH
-      sessions <- asks remoteHostSessions
-      void . atomically $ TM.lookupDelete (RHId remoteHostId) sessions
-      toView $ CRRemoteHostStopped remoteHostId
+      cancelRemoteHostSession True False rhKey
     pollEvents :: ChatMonad m => RemoteHostId -> RemoteHostClient -> m ()
     pollEvents rhId rhClient = do
       oq <- asks outputQ
@@ -225,12 +219,23 @@ startRemoteHost rh_ = do
 closeRemoteHost :: ChatMonad m => RHKey -> m ()
 closeRemoteHost rhKey = do
   logNote $ "Closing remote host session for " <> tshow rhKey
-  chatModifyVar currentRemoteHost $ \cur -> if (RHId <$> cur) == Just rhKey then Nothing else cur -- only wipe the closing RH
-  join . withRemoteHostSession_ rhKey . maybe (Left $ ChatErrorRemoteHost rhKey RHEInactive) $
-    \s -> Right (liftIO $ cancelRemoteHost s, Nothing)
+  cancelRemoteHostSession False True rhKey
 
-cancelRemoteHost :: RemoteHostSession -> IO ()
-cancelRemoteHost = \case
+cancelRemoteHostSession :: ChatMonad m => Bool -> Bool -> RHKey -> m ()
+cancelRemoteHostSession sendEvent stopHttp rhKey = handleAny (logError . tshow) $ do
+  chatModifyVar currentRemoteHost $ \cur -> if (RHId <$> cur) == Just rhKey then Nothing else cur -- only wipe the closing RH
+  sessions <- asks remoteHostSessions
+  session_ <- atomically $ TM.lookupDelete rhKey sessions
+  forM_ session_ $ \session -> do
+    liftIO $ cancelRemoteHost stopHttp session
+    when sendEvent $ toView $ CRRemoteHostStopped rhId_
+  where
+    rhId_ = case rhKey of
+      RHNew -> Nothing
+      RHId rhId -> Just rhId
+
+cancelRemoteHost :: Bool -> RemoteHostSession -> IO ()
+cancelRemoteHost stopHttp = \case
   RHSessionStarting -> pure ()
   RHSessionConnecting _inv rhs -> cancelPendingSession rhs
   RHSessionPendingConfirmation _sessCode tls rhs -> do
@@ -241,9 +246,9 @@ cancelRemoteHost = \case
     closeConnection tls
   RHSessionConnected {rchClient, tls, rhClient = RemoteHostClient {httpClient}, pollAction} -> do
     uninterruptibleCancel pollAction
-    closeHTTP2Client httpClient
-    closeConnection tls
-    cancelHostClient rchClient
+    when stopHttp $ closeHTTP2Client httpClient `catchAny` (logError . tshow)
+    closeConnection tls `catchAny` (logError . tshow)
+    cancelHostClient rchClient `catchAny` (logError . tshow)
   where
     cancelPendingSession RHPendingSession {rchClient, rhsWaitSession} = do
       uninterruptibleCancel rhsWaitSession
@@ -544,22 +549,23 @@ verifyRemoteCtrlSession execChatCommand sessCode' = handleCtrlError "verifyRemot
     monitor server = do
       res <- waitCatch server
       logInfo $ "HTTP2 server stopped: " <> tshow res
-      cancelActiveRemoteCtrl
-      toView CRRemoteCtrlStopped
+      cancelActiveRemoteCtrl True
 
 stopRemoteCtrl :: ChatMonad m => m ()
-stopRemoteCtrl =
-  join . withRemoteCtrlSession_ . maybe (Left $ ChatErrorRemoteCtrl RCEInactive) $
-    \s -> Right (liftIO $ cancelRemoteCtrl s, Nothing)
+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
+  cancelActiveRemoteCtrl True
   throwError e
 
-cancelActiveRemoteCtrl :: ChatMonad m => m ()
-cancelActiveRemoteCtrl = withRemoteCtrlSession_ (\s -> pure (s, Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl)
+cancelActiveRemoteCtrl :: ChatMonad m => Bool -> m ()
+cancelActiveRemoteCtrl sendEvent = handleAny (logError . tshow) $ do
+  session_ <- withRemoteCtrlSession_ (\s -> pure (s, Nothing))
+  forM_ session_ $ \session -> do
+    liftIO $ cancelRemoteCtrl session
+    when sendEvent $ toView CRRemoteCtrlStopped
 
 cancelRemoteCtrl :: RemoteCtrlSession -> IO ()
 cancelRemoteCtrl = \case
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 98a3edd47..a6843de60 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -297,7 +297,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
     ]
   CRNewRemoteHost RemoteHostInfo {remoteHostId = rhId, hostDeviceName} -> ["new remote host " <> sShow rhId <> " added: " <> plain hostDeviceName]
   CRRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} -> ["remote host " <> sShow rhId <> " connected"]
-  CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
+  CRRemoteHostStopped rhId_ ->
+    [ maybe "new remote host" (mappend "remote host " . sShow) rhId_ <> " stopped"
+    ]
   CRRemoteFileStored rhId (CryptoFile filePath cfArgs_) ->
     [plain $ "file " <> filePath <> " stored on remote host " <> show rhId]
       <> maybe [] ((: []) . plain . cryptoFileArgsStr testView) cfArgs_
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index e3bef7f9e..0d3dc7462 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module RemoteTests where
@@ -40,7 +39,7 @@ remoteTests = describe "Remote" $ do
   it "sends messages" remoteMessageTest
   describe "remote files" $ do
     it "store/get/send/receive files" remoteStoreFileTest
-    it "should send files from CLI wihtout /store" remoteCLIFileTest
+    it "should send files from CLI without /store" remoteCLIFileTest
   it "switches remote hosts" switchRemoteHostTest
   it "indicates remote hosts" indicateRemoteHostTest
 
@@ -439,24 +438,15 @@ stopDesktop :: HasCallStack => TestCC -> TestCC -> IO ()
 stopDesktop mobile desktop = do
   logWarn "stopping via desktop"
   desktop ##> "/stop remote host 1"
-  -- desktop <## "ok"
-  concurrentlyN_
-    [ do
-        desktop <## "remote host 1 stopped"
-        desktop <## "ok",
-      eventually 3 $ mobile <## "remote controller stopped"
-    ]
+  desktop <## "ok"
+  eventually 3 $ mobile <## "remote controller stopped"
 
 stopMobile :: HasCallStack => TestCC -> TestCC -> IO ()
 stopMobile mobile desktop = do
   logWarn "stopping via mobile"
   mobile ##> "/stop remote ctrl"
-  concurrentlyN_
-    [ do
-        mobile <## "remote controller stopped"
-        mobile <## "ok",
-      eventually 3 $ desktop <## "remote host 1 stopped"
-    ]
+  mobile <## "ok"
+  eventually 3 $ desktop <## "remote host 1 stopped"
 
 -- | Run action with extended timeout
 eventually :: Int -> IO a -> IO a

From c31ae396176394f48287f5f1dfb0ce25b1f9d3f2 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Thu, 16 Nov 2023 16:56:39 +0200
Subject: [PATCH 49/69] remote: fix circular error handling (#3380)

---
 src/Simplex/Chat.hs        |  4 ++--
 src/Simplex/Chat/Remote.hs | 46 +++++++++++++++++++-------------------
 2 files changed, 25 insertions(+), 25 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index ea16785e4..e2439f69d 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -375,8 +375,8 @@ restoreCalls = do
 
 stopChatController :: forall m. MonadUnliftIO m => ChatController -> m ()
 stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags, remoteHostSessions, remoteCtrlSession} = do
-  readTVarIO remoteHostSessions >>= mapM_ (liftIO . cancelRemoteHost True)
-  atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl)
+  readTVarIO remoteHostSessions >>= mapM_ (liftIO . cancelRemoteHost False)
+  atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl False)
   disconnectAgentClient smpAgent
   readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2)
   closeFiles sndFiles
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 23d74404d..331e3348a 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -159,10 +159,10 @@ startRemoteHost rh_ = do
     handleHostError :: ChatMonad m => TVar RHKey -> m () -> m ()
     handleHostError rhKeyVar action = action `catchChatError` \err -> do
       logError $ "startRemoteHost.waitForHostSession crashed: " <> tshow err
-      readTVarIO rhKeyVar >>= cancelRemoteHostSession True True
+      readTVarIO rhKeyVar >>= cancelRemoteHostSession True
     waitForHostSession :: ChatMonad m => Maybe RemoteHostInfo -> RHKey -> TVar RHKey -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
     waitForHostSession remoteHost_ rhKey rhKeyVar vars = do
-      (sessId, tls, vars') <- takeRCStep vars -- no timeout, waiting for user to scan invite
+      (sessId, tls, vars') <- timeoutThrow (ChatErrorRemoteHost rhKey RHETimeout) 60000000 $ takeRCStep vars
       let sessionCode = verificationCode sessId
       withRemoteHostSession rhKey $ \case
         RHSessionConnecting _inv rhs' -> Right ((), RHSessionPendingConfirmation sessionCode tls rhs') -- TODO check it's the same session?
@@ -170,7 +170,7 @@ startRemoteHost rh_ = do
       -- display confirmation code, wait for mobile to confirm
       let rh_' = (\rh -> (rh :: RemoteHostInfo) {sessionState = Just $ RHSPendingConfirmation {sessionCode}}) <$> remoteHost_
       toView $ CRRemoteHostSessionCode {remoteHost_ = rh_', sessionCode}
-      (RCHostSession {sessionKeys}, rhHello, pairing') <- takeRCStep vars' -- no timeout, waiting for user to compare the code
+      (RCHostSession {sessionKeys}, rhHello, pairing') <- timeoutThrow (ChatErrorRemoteHost rhKey RHETimeout) 60000000 $ takeRCStep vars'
       hostInfo@HostAppInfo {deviceName = hostDeviceName} <-
         liftError (ChatErrorRemoteHost rhKey) $ parseHostAppInfo rhHello
       withRemoteHostSession rhKey $ \case
@@ -206,7 +206,7 @@ startRemoteHost rh_ = do
     onDisconnected :: ChatMonad m => RHKey -> m ()
     onDisconnected rhKey = do
       logDebug "HTTP2 client disconnected"
-      cancelRemoteHostSession True False rhKey
+      cancelRemoteHostSession True rhKey
     pollEvents :: ChatMonad m => RemoteHostId -> RemoteHostClient -> m ()
     pollEvents rhId rhClient = do
       oq <- asks outputQ
@@ -219,23 +219,23 @@ startRemoteHost rh_ = do
 closeRemoteHost :: ChatMonad m => RHKey -> m ()
 closeRemoteHost rhKey = do
   logNote $ "Closing remote host session for " <> tshow rhKey
-  cancelRemoteHostSession False True rhKey
+  cancelRemoteHostSession False rhKey
 
-cancelRemoteHostSession :: ChatMonad m => Bool -> Bool -> RHKey -> m ()
-cancelRemoteHostSession sendEvent stopHttp rhKey = handleAny (logError . tshow) $ do
+cancelRemoteHostSession :: ChatMonad m => Bool -> RHKey -> m ()
+cancelRemoteHostSession handlingError rhKey = handleAny (logError . tshow) $ do
   chatModifyVar currentRemoteHost $ \cur -> if (RHId <$> cur) == Just rhKey then Nothing else cur -- only wipe the closing RH
   sessions <- asks remoteHostSessions
-  session_ <- atomically $ TM.lookupDelete rhKey sessions
+  session_ <- atomically $ TM.lookupDelete rhKey sessions -- XXX: when invoked from delayed error handler this can wipe the next session instead
   forM_ session_ $ \session -> do
-    liftIO $ cancelRemoteHost stopHttp session
-    when sendEvent $ toView $ CRRemoteHostStopped rhId_
+    liftIO $ cancelRemoteHost handlingError session `catchAny` (logError . tshow)
+    when handlingError $ toView $ CRRemoteHostStopped rhId_
   where
     rhId_ = case rhKey of
       RHNew -> Nothing
       RHId rhId -> Just rhId
 
 cancelRemoteHost :: Bool -> RemoteHostSession -> IO ()
-cancelRemoteHost stopHttp = \case
+cancelRemoteHost handlingError = \case
   RHSessionStarting -> pure ()
   RHSessionConnecting _inv rhs -> cancelPendingSession rhs
   RHSessionPendingConfirmation _sessCode tls rhs -> do
@@ -246,13 +246,13 @@ cancelRemoteHost stopHttp = \case
     closeConnection tls
   RHSessionConnected {rchClient, tls, rhClient = RemoteHostClient {httpClient}, pollAction} -> do
     uninterruptibleCancel pollAction
-    when stopHttp $ closeHTTP2Client httpClient `catchAny` (logError . tshow)
-    closeConnection tls `catchAny` (logError . tshow)
     cancelHostClient rchClient `catchAny` (logError . tshow)
+    closeConnection tls `catchAny` (logError . tshow)
+    unless handlingError $ closeHTTP2Client httpClient `catchAny` (logError . tshow)
   where
     cancelPendingSession RHPendingSession {rchClient, rhsWaitSession} = do
-      uninterruptibleCancel rhsWaitSession
-      cancelHostClient rchClient
+      unless handlingError $ uninterruptibleCancel rhsWaitSession `catchAny` (logError . tshow)
+      cancelHostClient rchClient `catchAny` (logError . tshow)
 
 -- | Generate a random 16-char filepath without / in it by using base64url encoding.
 randomStorePath :: IO FilePath
@@ -561,24 +561,24 @@ handleCtrlError name action = action `catchChatError` \e -> do
   throwError e
 
 cancelActiveRemoteCtrl :: ChatMonad m => Bool -> m ()
-cancelActiveRemoteCtrl sendEvent = handleAny (logError . tshow) $ do
+cancelActiveRemoteCtrl handlingError = handleAny (logError . tshow) $ do
   session_ <- withRemoteCtrlSession_ (\s -> pure (s, Nothing))
   forM_ session_ $ \session -> do
-    liftIO $ cancelRemoteCtrl session
-    when sendEvent $ toView CRRemoteCtrlStopped
+    liftIO $ cancelRemoteCtrl handlingError session
+    when handlingError $ toView CRRemoteCtrlStopped
 
-cancelRemoteCtrl :: RemoteCtrlSession -> IO ()
-cancelRemoteCtrl = \case
+cancelRemoteCtrl :: Bool -> RemoteCtrlSession -> IO ()
+cancelRemoteCtrl handlingError = \case
   RCSessionStarting -> pure ()
   RCSessionConnecting {rcsClient, rcsWaitSession} -> do
-    uninterruptibleCancel rcsWaitSession
+    unless handlingError $ uninterruptibleCancel rcsWaitSession
     cancelCtrlClient rcsClient
   RCSessionPendingConfirmation {rcsClient, tls, rcsWaitSession} -> do
-    uninterruptibleCancel rcsWaitSession
+    unless handlingError $ uninterruptibleCancel rcsWaitSession
     cancelCtrlClient rcsClient
     closeConnection tls
   RCSessionConnected {rcsClient, tls, http2Server} -> do
-    uninterruptibleCancel http2Server
+    unless handlingError $ uninterruptibleCancel http2Server
     cancelCtrlClient rcsClient
     closeConnection tls
 

From 0322b9708b9675e67078c4fd9e1070eb939ceafa Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 16 Nov 2023 16:53:44 +0000
Subject: [PATCH 50/69] desktop, ios: remote desktop/mobile connection (#3223)

* ui: remote desktop/mobile connection (WIP)

* add startRemoteCtrl and capability (does not work)

* re-add view

* update core library

* iOS connects to CLI

* ios: mobile ui

* multiplatform types

* update lib

* iOS and desktop connected

* fix controllers list on mobile

* remove iOS 16 paste button

* update device name

* connect existing device

* proposed model

* missing function names in exports

* unused

* remote host picker

* update type

* update lib, keep iOS session alive

* better UI

* update network statuses on switching remote/local hosts

* changes

* ios: prevent dismissing sheet/back when session is connected

* changes

* ios: fix back button asking to disconnect when not connected

* iOS: update type

* picker and session code

* multiplatform: update type

* menu fix

* ios: better ux

* desktop: better ux

* ios: options etc

* UI

* desktop: fix RemoteHostStopped event

* ios: open Use from desktop via picker

* desktop: "new mobile device"

* ios: load remote controllers synchronously, update on connect, fix alerts

* titles

* changes

* more changes to ui

* more and more changes in ui

* padding

* ios: show desktop version, handle errors

* fix stopped event

* refresh hosts always

* radical change

* optimization

* change

* ios: stop in progress session when closing window

---------

Co-authored-by: Avently <7953703+avently@users.noreply.github.com>
---
 apps/ios/Shared/Model/ChatModel.swift         |  35 ++
 apps/ios/Shared/Model/SimpleXAPI.swift        |  73 ++-
 .../Shared/Views/ChatList/ChatListView.swift  |  10 +-
 .../Shared/Views/ChatList/UserPicker.swift    |  14 +-
 .../RemoteAccess/ConnectDesktopView.swift     | 434 ++++++++++++++++++
 .../Views/UserSettings/SettingsView.swift     |  19 +-
 apps/ios/SimpleX (iOS).entitlements           |   2 +
 apps/ios/SimpleX.xcodeproj/project.pbxproj    |  52 ++-
 apps/ios/SimpleXChat/APITypes.swift           | 106 +++--
 .../src/commonMain/cpp/android/simplex-api.c  |   9 +
 .../src/commonMain/cpp/desktop/simplex-api.c  |   9 +
 .../kotlin/chat/simplex/common/App.kt         |  11 +-
 .../chat/simplex/common/model/ChatModel.kt    |  19 +
 .../chat/simplex/common/model/SimpleXAPI.kt   | 320 +++++++++----
 .../chat/simplex/common/platform/Core.kt      |   1 +
 .../simplex/common/views/chat/ChatView.kt     |   5 +-
 .../common/views/chat/item/ChatItemView.kt    |   2 +-
 .../common/views/chatlist/ChatListView.kt     |  49 +-
 .../common/views/chatlist/ShareListView.kt    |   7 +-
 .../common/views/chatlist/UserPicker.kt       | 255 ++++++++--
 .../simplex/common/views/helpers/ModalView.kt |   3 +-
 .../common/views/remote/ConnectMobileView.kt  | 359 +++++++++++++++
 .../common/views/usersettings/SettingsView.kt |   4 +
 .../commonMain/resources/MR/base/strings.xml  |  18 +
 .../resources/MR/images/ic_smartphone.svg     |   1 +
 .../resources/MR/images/ic_smartphone_300.svg |   1 +
 .../resources/MR/images/ic_wifi.svg           |   1 +
 .../resources/MR/images/ic_wifi_off.svg       |   1 +
 flake.nix                                     |   2 +
 libsimplex.dll.def                            |   1 +
 30 files changed, 1569 insertions(+), 254 deletions(-)
 create mode 100644 apps/ios/Shared/Views/RemoteAccess/ConnectDesktopView.swift
 create mode 100644 apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectMobileView.kt
 create mode 100644 apps/multiplatform/common/src/commonMain/resources/MR/images/ic_smartphone.svg
 create mode 100644 apps/multiplatform/common/src/commonMain/resources/MR/images/ic_smartphone_300.svg
 create mode 100644 apps/multiplatform/common/src/commonMain/resources/MR/images/ic_wifi.svg
 create mode 100644 apps/multiplatform/common/src/commonMain/resources/MR/images/ic_wifi_off.svg

diff --git a/apps/ios/Shared/Model/ChatModel.swift b/apps/ios/Shared/Model/ChatModel.swift
index fe9032e7c..90e4272b0 100644
--- a/apps/ios/Shared/Model/ChatModel.swift
+++ b/apps/ios/Shared/Model/ChatModel.swift
@@ -85,6 +85,8 @@ final class ChatModel: ObservableObject {
     @Published var activeCall: Call?
     @Published var callCommand: WCallCommand?
     @Published var showCallView = false
+    // remote desktop
+    @Published var remoteCtrlSession: RemoteCtrlSession?
     // currently showing QR code
     @Published var connReqInv: String?
     // audio recording and playback
@@ -110,6 +112,10 @@ final class ChatModel: ObservableObject {
         notificationMode == .periodic || ntfEnablePeriodicGroupDefault.get()
     }
 
+    var activeRemoteCtrl: Bool {
+        remoteCtrlSession?.active ?? false
+    }
+
     func getUser(_ userId: Int64) -> User? {
         currentUser?.userId == userId
         ? currentUser
@@ -762,3 +768,32 @@ final class GMember: ObservableObject, Identifiable {
     var viewId: String { get { "\(wrapped.id) \(created.timeIntervalSince1970)" } }
     static let sampleData = GMember(GroupMember.sampleData)
 }
+
+struct RemoteCtrlSession {
+    var ctrlAppInfo: CtrlAppInfo
+    var appVersion: String
+    var sessionState: UIRemoteCtrlSessionState
+
+    func updateState(_ state: UIRemoteCtrlSessionState) -> RemoteCtrlSession {
+        RemoteCtrlSession(ctrlAppInfo: ctrlAppInfo, appVersion: appVersion, sessionState: state)
+    }
+
+    var active: Bool {
+        if case .connected = sessionState { true } else { false }
+    }
+
+    var sessionCode: String? {
+        switch sessionState {
+        case let .pendingConfirmation(_, sessionCode): sessionCode
+        case let .connected(_, sessionCode): sessionCode
+        default: nil
+        }
+    }
+}
+
+enum UIRemoteCtrlSessionState {
+    case starting
+    case connecting(remoteCtrl_: RemoteCtrlInfo?)
+    case pendingConfirmation(remoteCtrl_: RemoteCtrlInfo?, sessionCode: String)
+    case connected(remoteCtrl: RemoteCtrlInfo, sessionCode: String)
+}
diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift
index f47d39193..f1aba9126 100644
--- a/apps/ios/Shared/Model/SimpleXAPI.swift
+++ b/apps/ios/Shared/Model/SimpleXAPI.swift
@@ -905,30 +905,36 @@ func apiCancelFile(fileId: Int64) async -> AChatItem? {
     }
 }
 
-func startRemoteCtrl() async throws {
-    try await sendCommandOkResp(.startRemoteCtrl)
+func setLocalDeviceName(_ displayName: String) throws {
+    try sendCommandOkRespSync(.setLocalDeviceName(displayName: displayName))
 }
 
-func registerRemoteCtrl(_ remoteCtrlOOB: RemoteCtrlOOB) async throws -> RemoteCtrlInfo {
-    let r = await chatSendCmd(.registerRemoteCtrl(remoteCtrlOOB: remoteCtrlOOB))
-    if case let .remoteCtrlRegistered(rcInfo) = r { return rcInfo }
+func connectRemoteCtrl(desktopAddress: String) async throws -> (RemoteCtrlInfo?, CtrlAppInfo, String) {
+    let r = await chatSendCmd(.connectRemoteCtrl(xrcpInvitation: desktopAddress))
+    if case let .remoteCtrlConnecting(rc_, ctrlAppInfo, v) = r { return (rc_, ctrlAppInfo, v) }
     throw r
 }
 
-func listRemoteCtrls() async throws -> [RemoteCtrlInfo] {
-    let r = await chatSendCmd(.listRemoteCtrls)
+func findKnownRemoteCtrl() async throws {
+    try await sendCommandOkResp(.findKnownRemoteCtrl)
+}
+
+func confirmRemoteCtrl(_ rcId: Int64) async throws {
+    try await sendCommandOkResp(.confirmRemoteCtrl(remoteCtrlId: rcId))
+}
+
+func verifyRemoteCtrlSession(_ sessCode: String) async throws -> RemoteCtrlInfo {
+    let r = await chatSendCmd(.verifyRemoteCtrlSession(sessionCode: sessCode))
+    if case let .remoteCtrlConnected(rc) = r { return rc }
+    throw r
+}
+
+func listRemoteCtrls() throws -> [RemoteCtrlInfo] {
+    let r = chatSendCmdSync(.listRemoteCtrls)
     if case let .remoteCtrlList(rcInfo) = r { return rcInfo }
     throw r
 }
 
-func acceptRemoteCtrl(_ rcId: Int64) async throws {
-    try await sendCommandOkResp(.acceptRemoteCtrl(remoteCtrlId: rcId))
-}
-
-func rejectRemoteCtrl(_ rcId: Int64) async throws {
-    try await sendCommandOkResp(.rejectRemoteCtrl(remoteCtrlId: rcId))
-}
-
 func stopRemoteCtrl() async throws {
     try await sendCommandOkResp(.stopRemoteCtrl)
 }
@@ -1065,6 +1071,12 @@ private func sendCommandOkResp(_ cmd: ChatCommand) async throws {
     throw r
 }
 
+private func sendCommandOkRespSync(_ cmd: ChatCommand) throws {
+    let r = chatSendCmdSync(cmd)
+    if case .cmdOk = r { return }
+    throw r
+}
+
 func apiNewGroup(incognito: Bool, groupProfile: GroupProfile) throws -> GroupInfo {
     let userId = try currentUserId("apiNewGroup")
     let r = chatSendCmdSync(.apiNewGroup(userId: userId, incognito: incognito, groupProfile: groupProfile))
@@ -1702,6 +1714,24 @@ func processReceivedMsg(_ res: ChatResponse) async {
         await MainActor.run {
             m.updateGroupMemberConnectionStats(groupInfo, member, ratchetSyncProgress.connectionStats)
         }
+    case let .remoteCtrlFound(remoteCtrl):
+        // TODO multicast
+        logger.debug("\(String(describing: remoteCtrl))")
+    case let .remoteCtrlSessionCode(remoteCtrl_, sessionCode):
+        await MainActor.run {
+            let state = UIRemoteCtrlSessionState.pendingConfirmation(remoteCtrl_: remoteCtrl_, sessionCode: sessionCode)
+            m.remoteCtrlSession = m.remoteCtrlSession?.updateState(state)
+        }
+    case let .remoteCtrlConnected(remoteCtrl):
+        // TODO currently it is returned in response to command, so it is redundant
+        await MainActor.run {
+            let state = UIRemoteCtrlSessionState.connected(remoteCtrl: remoteCtrl, sessionCode: m.remoteCtrlSession?.sessionCode ?? "")
+            m.remoteCtrlSession = m.remoteCtrlSession?.updateState(state)
+        }
+    case .remoteCtrlStopped:
+        await MainActor.run {
+            switchToLocalSession()
+        }
     default:
         logger.debug("unsupported event: \(res.responseType)")
     }
@@ -1715,6 +1745,19 @@ func processReceivedMsg(_ res: ChatResponse) async {
     }
 }
 
+func switchToLocalSession() {
+    let m = ChatModel.shared
+    m.remoteCtrlSession = nil
+    do {
+        m.users = try listUsers()
+        try getUserChatData()
+        let statuses = (try apiGetNetworkStatuses()).map { s in (s.agentConnId, s.networkStatus) }
+        m.networkStatuses = Dictionary(uniqueKeysWithValues: statuses)
+    } catch let error {
+        logger.debug("error updating chat data: \(responseError(error))")
+    }
+}
+
 func active(_ user: any UserLike) -> Bool {
     user.userId == ChatModel.shared.currentUser?.id
 }
diff --git a/apps/ios/Shared/Views/ChatList/ChatListView.swift b/apps/ios/Shared/Views/ChatList/ChatListView.swift
index a006f333f..1d8673320 100644
--- a/apps/ios/Shared/Views/ChatList/ChatListView.swift
+++ b/apps/ios/Shared/Views/ChatList/ChatListView.swift
@@ -15,6 +15,7 @@ struct ChatListView: View {
     @State private var searchText = ""
     @State private var showAddChat = false
     @State private var userPickerVisible = false
+    @State private var showConnectDesktop = false
     @AppStorage(DEFAULT_SHOW_UNREAD_AND_FAVORITES) private var showUnreadAndFavorites = false
 
     var body: some View {
@@ -48,7 +49,14 @@ struct ChatListView: View {
                     }
                 }
             }
-            UserPicker(showSettings: $showSettings, userPickerVisible: $userPickerVisible)
+            UserPicker(
+                showSettings: $showSettings,
+                showConnectDesktop: $showConnectDesktop,
+                userPickerVisible: $userPickerVisible
+            )
+        }
+        .sheet(isPresented: $showConnectDesktop) {
+            ConnectDesktopView()
         }
     }
 
diff --git a/apps/ios/Shared/Views/ChatList/UserPicker.swift b/apps/ios/Shared/Views/ChatList/UserPicker.swift
index bb88f5c38..741af6f08 100644
--- a/apps/ios/Shared/Views/ChatList/UserPicker.swift
+++ b/apps/ios/Shared/Views/ChatList/UserPicker.swift
@@ -13,6 +13,7 @@ struct UserPicker: View {
     @EnvironmentObject var m: ChatModel
     @Environment(\.colorScheme) var colorScheme
     @Binding var showSettings: Bool
+    @Binding var showConnectDesktop: Bool
     @Binding var userPickerVisible: Bool
     @State var scrollViewContentSize: CGSize = .zero
     @State var disableScrolling: Bool = true
@@ -62,6 +63,13 @@ struct UserPicker: View {
                 .simultaneousGesture(DragGesture(minimumDistance: disableScrolling ? 0 : 10000000))
                 .frame(maxHeight: scrollViewContentSize.height)
 
+                menuButton("Use from desktop", icon: "desktopcomputer") {
+                    showConnectDesktop = true
+                    withAnimation {
+                        userPickerVisible.toggle()
+                    }
+                }
+                Divider()
                 menuButton("Settings", icon: "gearshape") {
                     showSettings = true
                     withAnimation {
@@ -85,7 +93,7 @@ struct UserPicker: View {
             do {
                 m.users = try listUsers()
             } catch let error {
-                logger.error("Error updating users \(responseError(error))")
+                logger.error("Error loading users \(responseError(error))")
             }
         }
     }
@@ -144,7 +152,8 @@ struct UserPicker: View {
                     .overlay(DetermineWidth())
                 Spacer()
                 Image(systemName: icon)
-//                    .frame(width: 24, alignment: .center)
+                    .symbolRenderingMode(.monochrome)
+                    .foregroundColor(.secondary)
             }
             .padding(.horizontal)
             .padding(.vertical, 22)
@@ -170,6 +179,7 @@ struct UserPicker_Previews: PreviewProvider {
         m.users = [UserInfo.sampleData, UserInfo.sampleData]
         return UserPicker(
             showSettings: Binding.constant(false),
+            showConnectDesktop: Binding.constant(false),
             userPickerVisible: Binding.constant(true)
         )
         .environmentObject(m)
diff --git a/apps/ios/Shared/Views/RemoteAccess/ConnectDesktopView.swift b/apps/ios/Shared/Views/RemoteAccess/ConnectDesktopView.swift
new file mode 100644
index 000000000..0f6ef7be0
--- /dev/null
+++ b/apps/ios/Shared/Views/RemoteAccess/ConnectDesktopView.swift
@@ -0,0 +1,434 @@
+//
+//  ConnectDesktopView.swift
+//  SimpleX (iOS)
+//
+//  Created by Evgeny on 13/10/2023.
+//  Copyright © 2023 SimpleX Chat. All rights reserved.
+//
+
+import SwiftUI
+import SimpleXChat
+import CodeScanner
+
+struct ConnectDesktopView: View {
+    @EnvironmentObject var m: ChatModel
+    @Environment(\.dismiss) var dismiss: DismissAction
+    var viaSettings = false
+    @AppStorage(DEFAULT_DEVICE_NAME_FOR_REMOTE_ACCESS) private var deviceName = UIDevice.current.name
+    @AppStorage(DEFAULT_CONFIRM_REMOTE_SESSIONS) private var confirmRemoteSessions = false
+    @AppStorage(DEFAULT_CONNECT_REMOTE_VIA_MULTICAST) private var connectRemoteViaMulticast = false
+    @AppStorage(DEFAULT_OFFER_REMOTE_MULTICAST) private var offerRemoteMulticast = true
+    @AppStorage(DEFAULT_DEVELOPER_TOOLS) private var developerTools = false
+    @State private var sessionAddress: String = ""
+    @State private var remoteCtrls: [RemoteCtrlInfo] = []
+    @State private var alert: ConnectDesktopAlert?
+
+    private enum ConnectDesktopAlert: Identifiable {
+        case unlinkDesktop(rc: RemoteCtrlInfo)
+        case disconnectDesktop(action: UserDisconnectAction)
+        case badInvitationError
+        case badVersionError(version: String?)
+        case desktopDisconnectedError
+        case error(title: LocalizedStringKey, error: LocalizedStringKey = "")
+
+        var id: String {
+            switch self {
+            case let .unlinkDesktop(rc): "unlinkDesktop \(rc.remoteCtrlId)"
+            case let .disconnectDesktop(action): "disconnectDecktop \(action)"
+            case .badInvitationError: "badInvitationError"
+            case let .badVersionError(v): "badVersionError \(v ?? "")"
+            case .desktopDisconnectedError: "desktopDisconnectedError"
+            case let .error(title, _): "error \(title)"
+            }
+        }
+    }
+
+    private enum UserDisconnectAction: String {
+        case back
+        case dismiss // TODO dismiss settings after confirmation
+    }
+
+    var body: some View {
+        if viaSettings {
+            viewBody
+                .modifier(BackButton(label: "Back") {
+                    if m.activeRemoteCtrl {
+                        alert = .disconnectDesktop(action: .back)
+                    } else {
+                        dismiss()
+                    }
+                })
+        } else {
+            NavigationView {
+                viewBody
+            }
+        }
+    }
+
+    var viewBody: some View {
+        Group {
+            if let session = m.remoteCtrlSession {
+                switch session.sessionState {
+                case .starting: connectingDesktopView(session, nil)
+                case let .connecting(rc_): connectingDesktopView(session, rc_)
+                case let .pendingConfirmation(rc_, sessCode):
+                    if confirmRemoteSessions || rc_ == nil {
+                        verifySessionView(session, rc_, sessCode)
+                    } else {
+                        connectingDesktopView(session, rc_).onAppear {
+                            verifyDesktopSessionCode(sessCode)
+                        }
+                    }
+                case let .connected(rc, _): activeSessionView(session, rc)
+                }
+            } else {
+                connectDesktopView()
+            }
+        }
+        .onAppear {
+            setDeviceName(deviceName)
+            updateRemoteCtrls()
+        }
+        .onDisappear {
+            if m.remoteCtrlSession != nil {
+                disconnectDesktop()
+            }
+        }
+        .onChange(of: deviceName) {
+            setDeviceName($0)
+        }
+        .onChange(of: m.activeRemoteCtrl) {
+            UIApplication.shared.isIdleTimerDisabled = $0
+        }
+        .alert(item: $alert) { a in
+            switch a {
+            case let .unlinkDesktop(rc):
+                Alert(
+                    title: Text("Unlink desktop?"),
+                    primaryButton: .destructive(Text("Unlink")) {
+                        unlinkDesktop(rc)
+                    },
+                    secondaryButton: .cancel()
+                )
+            case let .disconnectDesktop(action):
+                Alert(
+                    title: Text("Disconnect desktop?"),
+                    primaryButton: .destructive(Text("Disconnect")) {
+                        disconnectDesktop(action)
+                    },
+                    secondaryButton: .cancel()
+                )
+            case .badInvitationError:
+                Alert(title: Text("Bad desktop address"))
+            case let .badVersionError(v):
+                Alert(
+                    title: Text("Incompatible version"),
+                    message: Text("Desktop app version \(v ?? "") is not compatible with this app.")
+                )
+            case .desktopDisconnectedError:
+                Alert(title: Text("Connection terminated"))
+            case let .error(title, error):
+                Alert(title: Text(title), message: Text(error))
+            }
+        }
+        .interactiveDismissDisabled(m.activeRemoteCtrl)
+    }
+
+    private func connectDesktopView() -> some View {
+        List {
+            Section("This device name") {
+                devicesView()
+            }
+            scanDesctopAddressView()
+            if developerTools {
+                desktopAddressView()
+            }
+        }
+        .navigationTitle("Connect to desktop")
+    }
+
+    private func connectingDesktopView(_ session: RemoteCtrlSession, _ rc: RemoteCtrlInfo?) -> some View {
+        List {
+            Section("Connecting to desktop") {
+                ctrlDeviceNameText(session, rc)
+                ctrlDeviceVersionText(session)
+            }
+
+            if let sessCode = session.sessionCode {
+                Section("Session code") {
+                    sessionCodeText(sessCode)
+                }
+            }
+
+            Section {
+                disconnectButton()
+            }
+        }
+        .navigationTitle("Connecting to desktop")
+    }
+
+    private func verifySessionView(_ session: RemoteCtrlSession, _ rc: RemoteCtrlInfo?, _ sessCode: String) -> some View {
+        List {
+            Section("Connected to desktop") {
+                ctrlDeviceNameText(session, rc)
+                ctrlDeviceVersionText(session)
+            }
+
+            Section("Verify code with desktop") {
+                sessionCodeText(sessCode)
+                Button {
+                    verifyDesktopSessionCode(sessCode)
+                } label: {
+                    Label("Confirm", systemImage: "checkmark")
+                }
+            }
+
+            Section {
+                disconnectButton()
+            }
+        }
+        .navigationTitle("Verify connection")
+    }
+
+    private func ctrlDeviceNameText(_ session: RemoteCtrlSession, _ rc: RemoteCtrlInfo?) -> Text {
+        var t = Text(rc?.deviceViewName ?? session.ctrlAppInfo.deviceName)
+        if (rc == nil) {
+            t = t + Text(" ") + Text("(new)").italic()
+        }
+        return t
+    }
+
+    private func ctrlDeviceVersionText(_ session: RemoteCtrlSession) -> Text {
+        let v = session.ctrlAppInfo.appVersionRange.maxVersion
+        var t = Text("v\(v)")
+        if v != session.appVersion {
+            t = t + Text(" ") + Text("(this device v\(session.appVersion))").italic()
+        }
+        return t
+    }
+
+    private func activeSessionView(_ session: RemoteCtrlSession, _ rc: RemoteCtrlInfo) -> some View {
+        List {
+            Section("Connected desktop") {
+                Text(rc.deviceViewName)
+                ctrlDeviceVersionText(session)
+            }
+
+            if let sessCode = session.sessionCode {
+                Section("Session code") {
+                    sessionCodeText(sessCode)
+                }
+            }
+
+            Section {
+                disconnectButton()
+            } footer: {
+                // This is specific to iOS
+                Text("Keep the app open to use it from desktop")
+            }
+        }
+        .navigationTitle("Connected to desktop")
+    }
+
+    private func sessionCodeText(_ code: String) -> some View {
+        Text(code.prefix(23))
+    }
+
+    private func devicesView() -> some View {
+        Group {
+            TextField("Enter this device name…", text: $deviceName)
+            if !remoteCtrls.isEmpty {
+                NavigationLink {
+                    linkedDesktopsView()
+                } label: {
+                    Text("Linked desktops")
+                }
+            }
+        }
+    }
+
+    private func scanDesctopAddressView() -> some View {
+        Section("Scan QR code from desktop") {
+            CodeScannerView(codeTypes: [.qr], completion: processDesktopQRCode)
+                .aspectRatio(1, contentMode: .fit)
+                .cornerRadius(12)
+                .listRowBackground(Color.clear)
+                .listRowSeparator(.hidden)
+                .listRowInsets(EdgeInsets(top: 0, leading: 0, bottom: 0, trailing: 0))
+                .padding(.horizontal)
+        }
+    }
+
+    private func desktopAddressView() -> some View {
+        Section("Desktop address") {
+            if sessionAddress.isEmpty {
+                Button {
+                    sessionAddress = UIPasteboard.general.string ?? ""
+                } label: {
+                    Label("Paste desktop address", systemImage: "doc.plaintext")
+                }
+                .disabled(!UIPasteboard.general.hasStrings)
+            } else {
+                HStack {
+                    Text(sessionAddress).lineLimit(1)
+                    Spacer()
+                    Image(systemName: "multiply.circle.fill")
+                        .foregroundColor(.secondary)
+                        .onTapGesture { sessionAddress = "" }
+                }
+            }
+            Button {
+                connectDesktopAddress(sessionAddress)
+            } label: {
+                Label("Connect to desktop", systemImage: "rectangle.connected.to.line.below")
+            }
+            .disabled(sessionAddress.isEmpty)
+        }
+    }
+
+    private func linkedDesktopsView() -> some View {
+        List {
+            Section("Desktop devices") {
+                ForEach(remoteCtrls, id: \.remoteCtrlId) { rc in
+                    remoteCtrlView(rc)
+                }
+                .onDelete { indexSet in
+                    if let i = indexSet.first, i < remoteCtrls.count {
+                        alert = .unlinkDesktop(rc: remoteCtrls[i])
+                    }
+                }
+            }
+
+            Section("Linked desktop options") {
+                Toggle("Verify connections", isOn: $confirmRemoteSessions)
+                Toggle("Discover on network", isOn: $connectRemoteViaMulticast).disabled(true)
+            }
+        }
+        .navigationTitle("Linked desktops")
+    }
+
+    private func remoteCtrlView(_ rc: RemoteCtrlInfo) -> some View {
+        Text(rc.deviceViewName)
+    }
+
+
+    private func setDeviceName(_ name: String) {
+        do {
+            try setLocalDeviceName(deviceName)
+        } catch let e {
+            errorAlert(e)
+        }
+    }
+
+    private func updateRemoteCtrls() {
+        do {
+            remoteCtrls = try listRemoteCtrls()
+        } catch let e {
+            errorAlert(e)
+        }
+    }
+
+    private func processDesktopQRCode(_ resp: Result<ScanResult, ScanError>) {
+        switch resp {
+        case let .success(r): connectDesktopAddress(r.string)
+        case let .failure(e): errorAlert(e)
+        }
+    }
+
+    private func connectDesktopAddress(_ addr: String) {
+        Task {
+            do {
+                let (rc_, ctrlAppInfo, v) = try await connectRemoteCtrl(desktopAddress: addr)
+                await MainActor.run {
+                    sessionAddress = ""
+                    m.remoteCtrlSession = RemoteCtrlSession(
+                        ctrlAppInfo: ctrlAppInfo,
+                        appVersion: v,
+                        sessionState: .connecting(remoteCtrl_: rc_)
+                    )
+                }
+            } catch let e {
+                await MainActor.run {
+                    switch e as? ChatResponse {
+                    case .chatCmdError(_, .errorRemoteCtrl(.badInvitation)): alert = .badInvitationError
+                    case .chatCmdError(_, .error(.commandError)): alert = .badInvitationError
+                    case let .chatCmdError(_, .errorRemoteCtrl(.badVersion(v))): alert = .badVersionError(version: v)
+                    case .chatCmdError(_, .errorAgent(.RCP(.version))): alert = .badVersionError(version: nil)
+                    case .chatCmdError(_, .errorAgent(.RCP(.ctrlAuth))): alert = .desktopDisconnectedError
+                    default: errorAlert(e)
+                    }
+                }
+            }
+        }
+    }
+
+    private func verifyDesktopSessionCode(_ sessCode: String) {
+        Task {
+            do {
+                let rc = try await verifyRemoteCtrlSession(sessCode)
+                await MainActor.run {
+                    m.remoteCtrlSession = m.remoteCtrlSession?.updateState(.connected(remoteCtrl: rc, sessionCode: sessCode))
+                }
+                await MainActor.run {
+                    updateRemoteCtrls()
+                }
+            } catch let error {
+                await MainActor.run {
+                    errorAlert(error)
+                }
+            }
+        }
+    }
+
+    private func disconnectButton() -> some View {
+        Button {
+            disconnectDesktop()
+        } label: {
+            Label("Disconnect", systemImage: "multiply")
+        }
+    }
+
+    private func disconnectDesktop(_ action: UserDisconnectAction? = nil) {
+        Task {
+            do {
+                try await stopRemoteCtrl()
+                await MainActor.run {
+                    switchToLocalSession()
+                    switch action {
+                    case .back: dismiss()
+                    case .dismiss: dismiss()
+                    case .none: ()
+                    }
+                }
+            } catch let e {
+                await MainActor.run {
+                    errorAlert(e)
+                }
+            }
+        }
+    }
+
+    private func unlinkDesktop(_ rc: RemoteCtrlInfo) {
+        Task {
+            do {
+                try await deleteRemoteCtrl(rc.remoteCtrlId)
+                await MainActor.run {
+                    remoteCtrls.removeAll(where: { $0.remoteCtrlId == rc.remoteCtrlId })
+                }
+            } catch let e {
+                await MainActor.run {
+                    errorAlert(e)
+                }
+            }
+        }
+    }
+
+    private func errorAlert(_ error: Error) {
+        let a = getErrorAlert(error, "Error")
+        alert = .error(title: a.title, error: a.message)
+    }
+}
+
+#Preview {
+    ConnectDesktopView()
+}
diff --git a/apps/ios/Shared/Views/UserSettings/SettingsView.swift b/apps/ios/Shared/Views/UserSettings/SettingsView.swift
index 1cc859f49..423786eb6 100644
--- a/apps/ios/Shared/Views/UserSettings/SettingsView.swift
+++ b/apps/ios/Shared/Views/UserSettings/SettingsView.swift
@@ -53,6 +53,10 @@ let DEFAULT_WHATS_NEW_VERSION = "defaultWhatsNewVersion"
 let DEFAULT_ONBOARDING_STAGE = "onboardingStage"
 let DEFAULT_CUSTOM_DISAPPEARING_MESSAGE_TIME = "customDisappearingMessageTime"
 let DEFAULT_SHOW_UNREAD_AND_FAVORITES = "showUnreadAndFavorites"
+let DEFAULT_DEVICE_NAME_FOR_REMOTE_ACCESS = "deviceNameForRemoteAccess"
+let DEFAULT_CONFIRM_REMOTE_SESSIONS = "confirmRemoteSessions"
+let DEFAULT_CONNECT_REMOTE_VIA_MULTICAST = "connectRemoteViaMulticast"
+let DEFAULT_OFFER_REMOTE_MULTICAST = "offerRemoteMulticast"
 
 let appDefaults: [String: Any] = [
     DEFAULT_SHOW_LA_NOTICE: false,
@@ -85,7 +89,10 @@ let appDefaults: [String: Any] = [
     DEFAULT_SHOW_MUTE_PROFILE_ALERT: true,
     DEFAULT_ONBOARDING_STAGE: OnboardingStage.onboardingComplete.rawValue,
     DEFAULT_CUSTOM_DISAPPEARING_MESSAGE_TIME: 300,
-    DEFAULT_SHOW_UNREAD_AND_FAVORITES: false
+    DEFAULT_SHOW_UNREAD_AND_FAVORITES: false,
+    DEFAULT_CONFIRM_REMOTE_SESSIONS: false,
+    DEFAULT_CONNECT_REMOTE_VIA_MULTICAST: false,
+    DEFAULT_OFFER_REMOTE_MULTICAST: true
 ]
 
 enum SimpleXLinkMode: String, Identifiable {
@@ -178,6 +185,12 @@ struct SettingsView: View {
                     } label: {
                         settingsRow("switch.2") { Text("Chat preferences") }
                     }
+
+                    NavigationLink {
+                        ConnectDesktopView(viaSettings: true)
+                    } label: {
+                        settingsRow("desktopcomputer") { Text("Use from desktop") }
+                    }
                 }
                 .disabled(chatModel.chatRunning != true)
                 
@@ -362,7 +375,9 @@ struct SettingsView: View {
 
 func settingsRow<Content : View>(_ icon: String, color: Color = .secondary, content: @escaping () -> Content) -> some View {
     ZStack(alignment: .leading) {
-        Image(systemName: icon).frame(maxWidth: 24, maxHeight: 24, alignment: .center).foregroundColor(color)
+        Image(systemName: icon).frame(maxWidth: 24, maxHeight: 24, alignment: .center)
+            .symbolRenderingMode(.monochrome)
+            .foregroundColor(color)
         content().padding(.leading, indent)
     }
 }
diff --git a/apps/ios/SimpleX (iOS).entitlements b/apps/ios/SimpleX (iOS).entitlements
index 51672d629..80e4adf2c 100644
--- a/apps/ios/SimpleX (iOS).entitlements	
+++ b/apps/ios/SimpleX (iOS).entitlements	
@@ -18,5 +18,7 @@
 	<array>
 		<string>$(AppIdentifierPrefix)chat.simplex.app</string>
 	</array>
+	<key>com.apple.developer.networking.multicast</key>
+  	<true/>
 </dict>
 </plist>
diff --git a/apps/ios/SimpleX.xcodeproj/project.pbxproj b/apps/ios/SimpleX.xcodeproj/project.pbxproj
index e675772e7..62db4e43e 100644
--- a/apps/ios/SimpleX.xcodeproj/project.pbxproj
+++ b/apps/ios/SimpleX.xcodeproj/project.pbxproj
@@ -39,6 +39,7 @@
 		5C36027327F47AD5009F19D9 /* AppDelegate.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C36027227F47AD5009F19D9 /* AppDelegate.swift */; };
 		5C3A88CE27DF50170060F1C2 /* DetermineWidth.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C3A88CD27DF50170060F1C2 /* DetermineWidth.swift */; };
 		5C3A88D127DF57800060F1C2 /* FramedItemView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C3A88D027DF57800060F1C2 /* FramedItemView.swift */; };
+		5C3CCFCC2AE6BD3100C3F0C3 /* ConnectDesktopView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C3CCFCB2AE6BD3100C3F0C3 /* ConnectDesktopView.swift */; };
 		5C3F1D562842B68D00EC8A82 /* IntegrityErrorItemView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C3F1D552842B68D00EC8A82 /* IntegrityErrorItemView.swift */; };
 		5C3F1D58284363C400EC8A82 /* PrivacySettings.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C3F1D57284363C400EC8A82 /* PrivacySettings.swift */; };
 		5C4B3B0A285FB130003915F2 /* DatabaseView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C4B3B09285FB130003915F2 /* DatabaseView.swift */; };
@@ -117,6 +118,11 @@
 		5CCB939C297EFCB100399E78 /* NavStackCompat.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CCB939B297EFCB100399E78 /* NavStackCompat.swift */; };
 		5CCD403427A5F6DF00368C90 /* AddContactView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CCD403327A5F6DF00368C90 /* AddContactView.swift */; };
 		5CCD403727A5F9A200368C90 /* ScanToConnectView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CCD403627A5F9A200368C90 /* ScanToConnectView.swift */; };
+		5CDA5A2D2B04FE2D00A71D61 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CDA5A282B04FE2D00A71D61 /* libgmp.a */; };
+		5CDA5A2E2B04FE2D00A71D61 /* libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CDA5A292B04FE2D00A71D61 /* libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL-ghc9.6.3.a */; };
+		5CDA5A2F2B04FE2D00A71D61 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CDA5A2A2B04FE2D00A71D61 /* libffi.a */; };
+		5CDA5A302B04FE2D00A71D61 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CDA5A2B2B04FE2D00A71D61 /* libgmpxx.a */; };
+		5CDA5A312B04FE2D00A71D61 /* libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CDA5A2C2B04FE2D00A71D61 /* libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL.a */; };
 		5CDCAD482818589900503DA2 /* NotificationService.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CDCAD472818589900503DA2 /* NotificationService.swift */; };
 		5CE2BA702845308900EC33A6 /* SimpleXChat.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CE2BA682845308900EC33A6 /* SimpleXChat.framework */; };
 		5CE2BA712845308900EC33A6 /* SimpleXChat.framework in Embed Frameworks */ = {isa = PBXBuildFile; fileRef = 5CE2BA682845308900EC33A6 /* SimpleXChat.framework */; settings = {ATTRIBUTES = (CodeSignOnCopy, RemoveHeadersOnCopy, ); }; };
@@ -142,11 +148,6 @@
 		5CEACCED27DEA495000BD591 /* MsgContentView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEACCEC27DEA495000BD591 /* MsgContentView.swift */; };
 		5CEBD7462A5C0A8F00665FE2 /* KeyboardPadding.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEBD7452A5C0A8F00665FE2 /* KeyboardPadding.swift */; };
 		5CEBD7482A5F115D00665FE2 /* SetDeliveryReceiptsView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEBD7472A5F115D00665FE2 /* SetDeliveryReceiptsView.swift */; };
-		5CF4DF772AFF8D4E007893ED /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CF4DF722AFF8D4D007893ED /* libffi.a */; };
-		5CF4DF782AFF8D4E007893ED /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CF4DF732AFF8D4D007893ED /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a */; };
-		5CF4DF792AFF8D4E007893ED /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CF4DF742AFF8D4D007893ED /* libgmpxx.a */; };
-		5CF4DF7A2AFF8D4E007893ED /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CF4DF752AFF8D4E007893ED /* libgmp.a */; };
-		5CF4DF7B2AFF8D4E007893ED /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CF4DF762AFF8D4E007893ED /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a */; };
 		5CFA59C42860BC6200863A68 /* MigrateToAppGroupView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CFA59C32860BC6200863A68 /* MigrateToAppGroupView.swift */; };
 		5CFA59D12864782E00863A68 /* ChatArchiveView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CFA59CF286477B400863A68 /* ChatArchiveView.swift */; };
 		5CFE0921282EEAF60002594B /* ZoomableScrollView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CFE0920282EEAF60002594B /* ZoomableScrollView.swift */; };
@@ -282,6 +283,7 @@
 		5C36027227F47AD5009F19D9 /* AppDelegate.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = AppDelegate.swift; sourceTree = "<group>"; };
 		5C3A88CD27DF50170060F1C2 /* DetermineWidth.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = DetermineWidth.swift; sourceTree = "<group>"; };
 		5C3A88D027DF57800060F1C2 /* FramedItemView.swift */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.swift; path = FramedItemView.swift; sourceTree = "<group>"; };
+		5C3CCFCB2AE6BD3100C3F0C3 /* ConnectDesktopView.swift */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.swift; path = ConnectDesktopView.swift; sourceTree = "<group>"; };
 		5C3F1D552842B68D00EC8A82 /* IntegrityErrorItemView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = IntegrityErrorItemView.swift; sourceTree = "<group>"; };
 		5C3F1D57284363C400EC8A82 /* PrivacySettings.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = PrivacySettings.swift; sourceTree = "<group>"; };
 		5C422A7C27A9A6FA0097A1E1 /* SimpleX (iOS).entitlements */ = {isa = PBXFileReference; lastKnownFileType = text.plist.entitlements; path = "SimpleX (iOS).entitlements"; sourceTree = "<group>"; };
@@ -397,6 +399,11 @@
 		5CCB939B297EFCB100399E78 /* NavStackCompat.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = NavStackCompat.swift; sourceTree = "<group>"; };
 		5CCD403327A5F6DF00368C90 /* AddContactView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = AddContactView.swift; sourceTree = "<group>"; };
 		5CCD403627A5F9A200368C90 /* ScanToConnectView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ScanToConnectView.swift; sourceTree = "<group>"; };
+		5CDA5A282B04FE2D00A71D61 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
+		5CDA5A292B04FE2D00A71D61 /* libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL-ghc9.6.3.a"; sourceTree = "<group>"; };
+		5CDA5A2A2B04FE2D00A71D61 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
+		5CDA5A2B2B04FE2D00A71D61 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
+		5CDA5A2C2B04FE2D00A71D61 /* libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL.a"; sourceTree = "<group>"; };
 		5CDCAD452818589900503DA2 /* SimpleX NSE.appex */ = {isa = PBXFileReference; explicitFileType = "wrapper.app-extension"; includeInIndex = 0; path = "SimpleX NSE.appex"; sourceTree = BUILT_PRODUCTS_DIR; };
 		5CDCAD472818589900503DA2 /* NotificationService.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = NotificationService.swift; sourceTree = "<group>"; };
 		5CDCAD492818589900503DA2 /* Info.plist */ = {isa = PBXFileReference; lastKnownFileType = text.plist.xml; path = Info.plist; sourceTree = "<group>"; };
@@ -423,11 +430,6 @@
 		5CEACCEC27DEA495000BD591 /* MsgContentView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MsgContentView.swift; sourceTree = "<group>"; };
 		5CEBD7452A5C0A8F00665FE2 /* KeyboardPadding.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = KeyboardPadding.swift; sourceTree = "<group>"; };
 		5CEBD7472A5F115D00665FE2 /* SetDeliveryReceiptsView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = SetDeliveryReceiptsView.swift; sourceTree = "<group>"; };
-		5CF4DF722AFF8D4D007893ED /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
-		5CF4DF732AFF8D4D007893ED /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a"; sourceTree = "<group>"; };
-		5CF4DF742AFF8D4D007893ED /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
-		5CF4DF752AFF8D4E007893ED /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
-		5CF4DF762AFF8D4E007893ED /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a"; sourceTree = "<group>"; };
 		5CFA59C32860BC6200863A68 /* MigrateToAppGroupView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MigrateToAppGroupView.swift; sourceTree = "<group>"; };
 		5CFA59CF286477B400863A68 /* ChatArchiveView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ChatArchiveView.swift; sourceTree = "<group>"; };
 		5CFE0920282EEAF60002594B /* ZoomableScrollView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; name = ZoomableScrollView.swift; path = Shared/Views/ZoomableScrollView.swift; sourceTree = SOURCE_ROOT; };
@@ -505,13 +507,13 @@
 			isa = PBXFrameworksBuildPhase;
 			buildActionMask = 2147483647;
 			files = (
+				5CDA5A302B04FE2D00A71D61 /* libgmpxx.a in Frameworks */,
 				5CE2BA93284534B000EC33A6 /* libiconv.tbd in Frameworks */,
-				5CF4DF792AFF8D4E007893ED /* libgmpxx.a in Frameworks */,
-				5CF4DF772AFF8D4E007893ED /* libffi.a in Frameworks */,
+				5CDA5A2D2B04FE2D00A71D61 /* libgmp.a in Frameworks */,
+				5CDA5A2E2B04FE2D00A71D61 /* libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL-ghc9.6.3.a in Frameworks */,
+				5CDA5A2F2B04FE2D00A71D61 /* libffi.a in Frameworks */,
 				5CE2BA94284534BB00EC33A6 /* libz.tbd in Frameworks */,
-				5CF4DF7A2AFF8D4E007893ED /* libgmp.a in Frameworks */,
-				5CF4DF7B2AFF8D4E007893ED /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a in Frameworks */,
-				5CF4DF782AFF8D4E007893ED /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a in Frameworks */,
+				5CDA5A312B04FE2D00A71D61 /* libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL.a in Frameworks */,
 			);
 			runOnlyForDeploymentPostprocessing = 0;
 		};
@@ -544,6 +546,7 @@
 				5CB924DD27A8622200ACCCDD /* NewChat */,
 				5CFA59C22860B04D00863A68 /* Database */,
 				5CB634AB29E46CDB0066AD6B /* LocalAuth */,
+				5CA8D01B2AD9B076001FD661 /* RemoteAccess */,
 				5CB924DF27A8678B00ACCCDD /* UserSettings */,
 				5C2E261127A30FEA00F70299 /* TerminalView.swift */,
 			);
@@ -572,11 +575,11 @@
 		5C764E5C279C70B7000C6508 /* Libraries */ = {
 			isa = PBXGroup;
 			children = (
-				5CF4DF722AFF8D4D007893ED /* libffi.a */,
-				5CF4DF752AFF8D4E007893ED /* libgmp.a */,
-				5CF4DF742AFF8D4D007893ED /* libgmpxx.a */,
-				5CF4DF732AFF8D4D007893ED /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a */,
-				5CF4DF762AFF8D4E007893ED /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a */,
+				5CDA5A2A2B04FE2D00A71D61 /* libffi.a */,
+				5CDA5A282B04FE2D00A71D61 /* libgmp.a */,
+				5CDA5A2B2B04FE2D00A71D61 /* libgmpxx.a */,
+				5CDA5A292B04FE2D00A71D61 /* libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL-ghc9.6.3.a */,
+				5CDA5A2C2B04FE2D00A71D61 /* libHSsimplex-chat-5.4.0.3-rODxCBVsb2BkD1fnTAqXL.a */,
 			);
 			path = Libraries;
 			sourceTree = "<group>";
@@ -684,6 +687,14 @@
 			path = "Tests iOS";
 			sourceTree = "<group>";
 		};
+		5CA8D01B2AD9B076001FD661 /* RemoteAccess */ = {
+			isa = PBXGroup;
+			children = (
+				5C3CCFCB2AE6BD3100C3F0C3 /* ConnectDesktopView.swift */,
+			);
+			path = RemoteAccess;
+			sourceTree = "<group>";
+		};
 		5CB0BA8C282711BC00B3292C /* Onboarding */ = {
 			isa = PBXGroup;
 			children = (
@@ -1170,6 +1181,7 @@
 				6454036F2822A9750090DDFF /* ComposeFileView.swift in Sources */,
 				5C5DB70E289ABDD200730FFF /* AppearanceSettings.swift in Sources */,
 				5C5F2B6D27EBC3FE006A9D5F /* ImagePicker.swift in Sources */,
+				5C3CCFCC2AE6BD3100C3F0C3 /* ConnectDesktopView.swift in Sources */,
 				5C9C2DA92899DA6F00CC63B1 /* NetworkAndServers.swift in Sources */,
 				5C6BA667289BD954009B8ECC /* DismissSheets.swift in Sources */,
 				5C577F7D27C83AA10006112D /* MarkdownHelp.swift in Sources */,
diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift
index b893d0045..e7409a072 100644
--- a/apps/ios/SimpleXChat/APITypes.swift
+++ b/apps/ios/SimpleXChat/APITypes.swift
@@ -120,14 +120,16 @@ public enum ChatCommand {
     case receiveFile(fileId: Int64, encrypted: Bool?, inline: Bool?)
     case setFileToReceive(fileId: Int64, encrypted: Bool?)
     case cancelFile(fileId: Int64)
+    // remote desktop commands
     case setLocalDeviceName(displayName: String)
-    case startRemoteCtrl
-    case registerRemoteCtrl(remoteCtrlOOB: RemoteCtrlOOB)
+    case connectRemoteCtrl(xrcpInvitation: String)
+    case findKnownRemoteCtrl
+    case confirmRemoteCtrl(remoteCtrlId: Int64)
+    case verifyRemoteCtrlSession(sessionCode: String)
     case listRemoteCtrls
-    case acceptRemoteCtrl(remoteCtrlId: Int64)
-    case rejectRemoteCtrl(remoteCtrlId: Int64)
     case stopRemoteCtrl
     case deleteRemoteCtrl(remoteCtrlId: Int64)
+    // misc
     case showVersion
     case string(String)
 
@@ -269,10 +271,10 @@ public enum ChatCommand {
             case let .setFileToReceive(fileId, encrypt): return "/_set_file_to_receive \(fileId)\(onOffParam("encrypt", encrypt))"
             case let .cancelFile(fileId): return "/fcancel \(fileId)"
             case let .setLocalDeviceName(displayName): return "/set device name \(displayName)"
-            case .startRemoteCtrl: return "/start remote ctrl"
-            case let .registerRemoteCtrl(oob): return "/register remote ctrl \(oob.caFingerprint)"
-            case let .acceptRemoteCtrl(rcId): return "/accept remote ctrl \(rcId)"
-            case let .rejectRemoteCtrl(rcId): return "/reject remote ctrl \(rcId)"
+            case let .connectRemoteCtrl(xrcpInv): return "/connect remote ctrl \(xrcpInv)"
+            case .findKnownRemoteCtrl: return "/find remote ctrl"
+            case let .confirmRemoteCtrl(rcId): return "/confirm remote ctrl \(rcId)"
+            case let .verifyRemoteCtrlSession(sessCode): return "/verify remote ctrl \(sessCode)"
             case .listRemoteCtrls: return "/list remote ctrls"
             case .stopRemoteCtrl: return "/stop remote ctrl"
             case let .deleteRemoteCtrl(rcId): return "/delete remote ctrl \(rcId)"
@@ -392,11 +394,11 @@ public enum ChatCommand {
             case .setFileToReceive: return "setFileToReceive"
             case .cancelFile: return "cancelFile"
             case .setLocalDeviceName: return "setLocalDeviceName"
-            case .startRemoteCtrl: return "startRemoteCtrl"
-            case .registerRemoteCtrl: return "registerRemoteCtrl"
+            case .connectRemoteCtrl: return "connectRemoteCtrl"
+            case .findKnownRemoteCtrl: return "findKnownRemoteCtrl"
+            case .confirmRemoteCtrl: return "confirmRemoteCtrl"
+            case .verifyRemoteCtrlSession: return "verifyRemoteCtrlSession"
             case .listRemoteCtrls: return "listRemoteCtrls"
-            case .acceptRemoteCtrl: return "acceptRemoteCtrl"
-            case .rejectRemoteCtrl: return "rejectRemoteCtrl"
             case .stopRemoteCtrl: return "stopRemoteCtrl"
             case .deleteRemoteCtrl: return "deleteRemoteCtrl"
             case .showVersion: return "showVersion"
@@ -605,13 +607,14 @@ public enum ChatResponse: Decodable, Error {
     case ntfMessages(user_: User?, connEntity: ConnectionEntity?, msgTs: Date?, ntfMessages: [NtfMsgInfo])
     case newContactConnection(user: UserRef, connection: PendingContactConnection)
     case contactConnectionDeleted(user: UserRef, connection: PendingContactConnection)
+    // remote desktop responses/events
     case remoteCtrlList(remoteCtrls: [RemoteCtrlInfo])
-    case remoteCtrlRegistered(remoteCtrl: RemoteCtrlInfo)
-    case remoteCtrlAnnounce(fingerprint: String)
     case remoteCtrlFound(remoteCtrl: RemoteCtrlInfo)
-    case remoteCtrlConnecting(remoteCtrl: RemoteCtrlInfo)
+    case remoteCtrlConnecting(remoteCtrl_: RemoteCtrlInfo?, ctrlAppInfo: CtrlAppInfo, appVersion: String)
+    case remoteCtrlSessionCode(remoteCtrl_: RemoteCtrlInfo?, sessionCode: String)
     case remoteCtrlConnected(remoteCtrl: RemoteCtrlInfo)
     case remoteCtrlStopped
+    // misc
     case versionInfo(versionInfo: CoreVersionInfo, chatMigrations: [UpMigration], agentMigrations: [UpMigration])
     case cmdOk(user: UserRef?)
     case chatCmdError(user_: UserRef?, chatError: ChatError)
@@ -752,10 +755,9 @@ public enum ChatResponse: Decodable, Error {
             case .newContactConnection: return "newContactConnection"
             case .contactConnectionDeleted: return "contactConnectionDeleted"
             case .remoteCtrlList: return "remoteCtrlList"
-            case .remoteCtrlRegistered: return "remoteCtrlRegistered"
-            case .remoteCtrlAnnounce: return "remoteCtrlAnnounce"
             case .remoteCtrlFound: return "remoteCtrlFound"
             case .remoteCtrlConnecting: return "remoteCtrlConnecting"
+            case .remoteCtrlSessionCode: return "remoteCtrlSessionCode"
             case .remoteCtrlConnected: return "remoteCtrlConnected"
             case .remoteCtrlStopped: return "remoteCtrlStopped"
             case .versionInfo: return "versionInfo"
@@ -901,10 +903,9 @@ public enum ChatResponse: Decodable, Error {
             case let .newContactConnection(u, connection): return withUser(u, String(describing: connection))
             case let .contactConnectionDeleted(u, connection): return withUser(u, String(describing: connection))
             case let .remoteCtrlList(remoteCtrls): return String(describing: remoteCtrls)
-            case let .remoteCtrlRegistered(remoteCtrl): return String(describing: remoteCtrl)
-            case let .remoteCtrlAnnounce(fingerprint): return "fingerprint: \(fingerprint)"
             case let .remoteCtrlFound(remoteCtrl): return String(describing: remoteCtrl)
-            case let .remoteCtrlConnecting(remoteCtrl): return String(describing: remoteCtrl)
+            case let .remoteCtrlConnecting(remoteCtrl_, ctrlAppInfo, appVersion): return "remoteCtrl_:\n\(String(describing: remoteCtrl_))\nctrlAppInfo:\n\(String(describing: ctrlAppInfo))\nappVersion: \(appVersion)"
+            case let .remoteCtrlSessionCode(remoteCtrl_, sessionCode): return "remoteCtrl_:\n\(String(describing: remoteCtrl_))\nsessionCode: \(sessionCode)"
             case let .remoteCtrlConnected(remoteCtrl): return String(describing: remoteCtrl)
             case .remoteCtrlStopped: return noDetails
             case let .versionInfo(versionInfo, chatMigrations, agentMigrations): return "\(String(describing: versionInfo))\n\nchat migrations: \(chatMigrations.map(\.upName))\n\nagent migrations: \(agentMigrations.map(\.upName))"
@@ -1533,21 +1534,31 @@ public enum NotificationPreviewMode: String, SelectableItem {
     public static var values: [NotificationPreviewMode] = [.message, .contact, .hidden]
 }
 
-public struct RemoteCtrlOOB {
-    public var caFingerprint: String
-}
-
 public struct RemoteCtrlInfo: Decodable {
     public var remoteCtrlId: Int64
-    public var displayName: String
-    public var sessionActive: Bool
+    public var ctrlDeviceName: String
+    public var sessionState: RemoteCtrlSessionState?
+
+    public var deviceViewName: String {
+        ctrlDeviceName == "" ? "\(remoteCtrlId)" : ctrlDeviceName
+    }
 }
 
-public struct RemoteCtrl: Decodable {
-    var remoteCtrlId: Int64
-    var displayName: String
-    var fingerprint: String
-    var accepted: Bool?
+public enum RemoteCtrlSessionState: Decodable {
+    case starting
+    case connecting
+    case pendingConfirmation(sessionCode: String)
+    case connected(sessionCode: String)
+}
+
+public struct CtrlAppInfo: Decodable {
+    public var appVersionRange: AppVersionRange
+    public var deviceName: String
+}
+
+public struct AppVersionRange: Decodable {
+    public var minVersion: String
+    public var maxVersion: String
 }
 
 public struct CoreVersionInfo: Decodable {
@@ -1737,6 +1748,7 @@ public enum AgentErrorType: Decodable {
     case SMP(smpErr: ProtocolErrorType)
     case NTF(ntfErr: ProtocolErrorType)
     case XFTP(xftpErr: XFTPErrorType)
+    case RCP(rcpErr: RCErrorType)
     case BROKER(brokerAddress: String, brokerErr: BrokerErrorType)
     case AGENT(agentErr: SMPAgentError)
     case INTERNAL(internalErr: String)
@@ -1794,6 +1806,22 @@ public enum XFTPErrorType: Decodable {
     case INTERNAL
 }
 
+public enum RCErrorType: Decodable {
+    case `internal`(internalErr: String)
+    case identity
+    case noLocalAddress
+    case tlsStartFailed
+    case exception(exception: String)
+    case ctrlAuth
+    case ctrlNotFound
+    case ctrlError(ctrlErr: String)
+    case version
+    case encrypt
+    case decrypt
+    case blockSize
+    case syntax(syntaxErr: String)
+}
+
 public enum ProtocolCommandError: Decodable {
     case UNKNOWN
     case SYNTAX
@@ -1831,12 +1859,12 @@ public enum ArchiveError: Decodable {
 }
 
 public enum RemoteCtrlError: Decodable {
-  case inactive
-  case busy
-  case timeout
-  case disconnected(remoteCtrlId: Int64, reason: String)
-  case connectionLost(remoteCtrlId: Int64, reason: String)
-  case certificateExpired(remoteCtrlId: Int64)
-  case certificateUntrusted(remoteCtrlId: Int64)
-  case badFingerprint
+    case inactive
+    case badState
+    case busy
+    case timeout
+    case disconnected(remoteCtrlId: Int64, reason: String)
+    case badInvitation
+    case badVersion(appVersion: String)
+//    case protocolError(protocolError: RemoteProtocolError)
 }
diff --git a/apps/multiplatform/common/src/commonMain/cpp/android/simplex-api.c b/apps/multiplatform/common/src/commonMain/cpp/android/simplex-api.c
index 351ed93c9..b729e3b7f 100644
--- a/apps/multiplatform/common/src/commonMain/cpp/android/simplex-api.c
+++ b/apps/multiplatform/common/src/commonMain/cpp/android/simplex-api.c
@@ -41,6 +41,7 @@ typedef long* chat_ctrl;
 
 extern char *chat_migrate_init(const char *path, const char *key, const char *confirm, chat_ctrl *ctrl);
 extern char *chat_send_cmd(chat_ctrl ctrl, const char *cmd);
+extern char *chat_send_remote_cmd(chat_ctrl ctrl, const int rhId, const char *cmd);
 extern char *chat_recv_msg(chat_ctrl ctrl); // deprecated
 extern char *chat_recv_msg_wait(chat_ctrl ctrl, const int wait);
 extern char *chat_parse_markdown(const char *str);
@@ -86,6 +87,14 @@ Java_chat_simplex_common_platform_CoreKt_chatSendCmd(JNIEnv *env, __unused jclas
     return res;
 }
 
+JNIEXPORT jstring JNICALL
+Java_chat_simplex_common_platform_CoreKt_chatSendRemoteCmd(JNIEnv *env, __unused jclass clazz, jlong controller, jint rhId, jstring msg) {
+    const char *_msg = (*env)->GetStringUTFChars(env, msg, JNI_FALSE);
+    jstring res = (*env)->NewStringUTF(env, chat_send_remote_cmd((void*)controller, rhId, _msg));
+    (*env)->ReleaseStringUTFChars(env, msg, _msg);
+    return res;
+}
+
 JNIEXPORT jstring JNICALL
 Java_chat_simplex_common_platform_CoreKt_chatRecvMsg(JNIEnv *env, __unused jclass clazz, jlong controller) {
     return (*env)->NewStringUTF(env, chat_recv_msg((void*)controller));
diff --git a/apps/multiplatform/common/src/commonMain/cpp/desktop/simplex-api.c b/apps/multiplatform/common/src/commonMain/cpp/desktop/simplex-api.c
index f36c86c36..1b0d11a2b 100644
--- a/apps/multiplatform/common/src/commonMain/cpp/desktop/simplex-api.c
+++ b/apps/multiplatform/common/src/commonMain/cpp/desktop/simplex-api.c
@@ -16,6 +16,7 @@ typedef long* chat_ctrl;
 
 extern char *chat_migrate_init(const char *path, const char *key, const char *confirm, chat_ctrl *ctrl);
 extern char *chat_send_cmd(chat_ctrl ctrl, const char *cmd);
+extern char *chat_send_remote_cmd(chat_ctrl ctrl, const int rhId, const char *cmd);
 extern char *chat_recv_msg(chat_ctrl ctrl); // deprecated
 extern char *chat_recv_msg_wait(chat_ctrl ctrl, const int wait);
 extern char *chat_parse_markdown(const char *str);
@@ -98,6 +99,14 @@ Java_chat_simplex_common_platform_CoreKt_chatSendCmd(JNIEnv *env, jclass clazz,
     return res;
 }
 
+JNIEXPORT jstring JNICALL
+Java_chat_simplex_common_platform_CoreKt_chatSendRemoteCmd(JNIEnv *env, jclass clazz, jlong controller, jint rhId, jstring msg) {
+    const char *_msg = encode_to_utf8_chars(env, msg);
+    jstring res = decode_to_utf8_string(env, chat_send_remote_cmd((void*)controller, rhId, _msg));
+    (*env)->ReleaseStringUTFChars(env, msg, _msg);
+    return res;
+}
+
 JNIEXPORT jstring JNICALL
 Java_chat_simplex_common_platform_CoreKt_chatRecvMsg(JNIEnv *env, jclass clazz, jlong controller) {
     return decode_to_utf8_string(env, chat_recv_msg((void*)controller));
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/App.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/App.kt
index 82201cce0..41deee7a5 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/App.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/App.kt
@@ -38,7 +38,7 @@ import kotlinx.coroutines.flow.*
 data class SettingsViewState(
   val userPickerState: MutableStateFlow<AnimatedViewState>,
   val scaffoldState: ScaffoldState,
-  val switchingUsers: MutableState<Boolean>
+  val switchingUsersAndHosts: MutableState<Boolean>
 )
 
 @Composable
@@ -121,8 +121,8 @@ fun MainScreen() {
           showAdvertiseLAAlert = true
           val userPickerState by rememberSaveable(stateSaver = AnimatedViewState.saver()) { mutableStateOf(MutableStateFlow(AnimatedViewState.GONE)) }
           val scaffoldState = rememberScaffoldState()
-          val switchingUsers = rememberSaveable { mutableStateOf(false) }
-          val settingsState = remember { SettingsViewState(userPickerState, scaffoldState, switchingUsers) }
+          val switchingUsersAndHosts = rememberSaveable { mutableStateOf(false) }
+          val settingsState = remember { SettingsViewState(userPickerState, scaffoldState, switchingUsersAndHosts) }
           if (appPlatform.isAndroid) {
             AndroidScreen(settingsState)
           } else {
@@ -298,7 +298,7 @@ fun DesktopScreen(settingsState: SettingsViewState) {
         EndPartOfScreen()
       }
     }
-    val (userPickerState, scaffoldState, switchingUsers ) = settingsState
+    val (userPickerState, scaffoldState, switchingUsersAndHosts ) = settingsState
     val scope = rememberCoroutineScope()
     if (scaffoldState.drawerState.isOpen) {
       Box(
@@ -312,8 +312,9 @@ fun DesktopScreen(settingsState: SettingsViewState) {
       )
     }
     VerticalDivider(Modifier.padding(start = DEFAULT_START_MODAL_WIDTH))
-    UserPicker(chatModel, userPickerState, switchingUsers) {
+    UserPicker(chatModel, userPickerState, switchingUsersAndHosts) {
       scope.launch { if (scaffoldState.drawerState.isOpen) scaffoldState.drawerState.close() else scaffoldState.drawerState.open() }
+      userPickerState.value = AnimatedViewState.GONE
     }
     ModalManager.fullscreen.showInView()
   }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
index 91b4a8d8f..2de944f59 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
@@ -106,6 +106,11 @@ object ChatModel {
 
   var updatingChatsMutex: Mutex = Mutex()
 
+  // remote controller
+  val remoteHosts = mutableStateListOf<RemoteHostInfo>()
+  val currentRemoteHost = mutableStateOf<RemoteHostInfo?>(null)
+  val newRemoteHostPairing = mutableStateOf<Pair<RemoteHostInfo?, RemoteHostSessionState>?>(null)
+
   fun getUser(userId: Long): User? = if (currentUser.value?.userId == userId) {
     currentUser.value
   } else {
@@ -2841,3 +2846,17 @@ enum class NotificationPreviewMode {
     val default: NotificationPreviewMode = MESSAGE
   }
 }
+
+data class RemoteCtrlSession(
+  val ctrlAppInfo: CtrlAppInfo,
+  val appVersion: String,
+  val sessionState: RemoteCtrlSessionState
+)
+
+@Serializable
+sealed class RemoteCtrlSessionState {
+  @Serializable @SerialName("starting") object Starting: RemoteCtrlSessionState()
+  @Serializable @SerialName("connecting") object Connecting: RemoteCtrlSessionState()
+  @Serializable @SerialName("pendingConfirmation") data class PendingConfirmation(val sessionCode: String): RemoteCtrlSessionState()
+  @Serializable @SerialName("connected") data class Connected(val sessionCode: String): RemoteCtrlSessionState()
+}
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
index 7896d2d6e..98c48dbfb 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
@@ -345,11 +345,6 @@ object ChatController {
       val users = listUsers()
       chatModel.users.clear()
       chatModel.users.addAll(users)
-      val remoteHosts = listRemoteHosts()
-      if (remoteHosts != null) {
-        chatModel.remoteHosts.clear()
-        chatModel.remoteHosts.addAll(remoteHosts)
-      }
       if (justStarted) {
         chatModel.currentUser.value = user
         chatModel.userCreated.value = true
@@ -357,6 +352,7 @@ object ChatController {
         appPrefs.chatLastStart.set(Clock.System.now())
         chatModel.chatRunning.value = true
         startReceiver()
+        setLocalDeviceName(appPrefs.deviceNameForRemoteAccess.get()!!)
         Log.d(TAG, "startChat: started")
       } else {
         updatingChatsMutex.withLock {
@@ -429,7 +425,8 @@ object ChatController {
       val c = cmd.cmdString
       chatModel.addTerminalItem(TerminalItem.cmd(cmd.obfuscated))
       Log.d(TAG, "sendCmd: ${cmd.cmdType}")
-      val json = chatSendCmd(ctrl, c)
+      val rhId = chatModel.currentRemoteHost.value?.remoteHostId?.toInt() ?: -1
+      val json = if (rhId == -1) chatSendCmd(ctrl, c) else chatSendRemoteCmd(ctrl, rhId, c)
       val r = APIResponse.decodeStr(json)
       Log.d(TAG, "sendCmd response type ${r.resp.responseType}")
       if (r.resp is CR.Response || r.resp is CR.Invalid) {
@@ -1174,10 +1171,10 @@ object ChatController {
     }
   }
 
-  suspend fun cancelFile(user: User, fileId: Long) {
+  suspend fun cancelFile(rhId: Long?, user: User, fileId: Long) {
     val chatItem = apiCancelFile(fileId)
     if (chatItem != null) {
-      chatItemSimpleUpdate(user, chatItem)
+      chatItemSimpleUpdate(rhId, user, chatItem)
       cleanupFile(chatItem)
     }
   }
@@ -1371,46 +1368,77 @@ object ChatController {
 
   suspend fun setLocalDeviceName(displayName: String): Boolean = sendCommandOkResp(CC.SetLocalDeviceName(displayName))
 
-  suspend fun createRemoteHost(): RemoteHostInfo? {
-    val r = sendCmd(CC.CreateRemoteHost())
-    if (r is CR.RemoteHostCreated) return r.remoteHost
-    apiErrorAlert("createRemoteHost", generalGetString(MR.strings.error), r)
-    return null
-  }
-
   suspend fun listRemoteHosts(): List<RemoteHostInfo>? {
     val r = sendCmd(CC.ListRemoteHosts())
     if (r is CR.RemoteHostList) return r.remoteHosts
-    apiErrorAlert("listRemoteHosts", generalGetString(MR.strings.error), r)
+    apiErrorAlert("listRemoteHosts", generalGetString(MR.strings.error_alert_title), r)
     return null
   }
 
-  suspend fun startRemoteHost(rhId: Long): Boolean = sendCommandOkResp(CC.StartRemoteHost(rhId))
+  suspend fun reloadRemoteHosts() {
+    val hosts = listRemoteHosts() ?: return
+    chatModel.remoteHosts.clear()
+    chatModel.remoteHosts.addAll(hosts)
+  }
 
-  suspend fun registerRemoteCtrl(oob: RemoteCtrlOOB): RemoteCtrlInfo? {
-    val r = sendCmd(CC.RegisterRemoteCtrl(oob))
-    if (r is CR.RemoteCtrlRegistered) return r.remoteCtrl
-    apiErrorAlert("registerRemoteCtrl", generalGetString(MR.strings.error), r)
+  suspend fun startRemoteHost(rhId: Long?, multicast: Boolean = false): Pair<RemoteHostInfo?, String>? {
+    val r = sendCmd(CC.StartRemoteHost(rhId, multicast))
+    if (r is CR.RemoteHostStarted) return r.remoteHost_ to r.invitation
+    apiErrorAlert("listRemoteHosts", generalGetString(MR.strings.error_alert_title), r)
     return null
   }
 
+  suspend fun switchRemoteHost (rhId: Long?): RemoteHostInfo? {
+    val r = sendCmd(CC.SwitchRemoteHost(rhId))
+    if (r is CR.CurrentRemoteHost) return r.remoteHost_
+    apiErrorAlert("switchRemoteHost", generalGetString(MR.strings.error_alert_title), r)
+    return null
+  }
+
+  suspend fun stopRemoteHost(rhId: Long?): Boolean = sendCommandOkResp(CC.StopRemoteHost(rhId))
+
+  fun stopRemoteHostAndReloadHosts(h: RemoteHostInfo, switchToLocal: Boolean) {
+    withBGApi {
+      stopRemoteHost(h.remoteHostId)
+      if (switchToLocal) {
+        switchUIRemoteHost(null)
+      } else {
+        reloadRemoteHosts()
+      }
+    }
+  }
+
+  suspend fun deleteRemoteHost(rhId: Long): Boolean = sendCommandOkResp(CC.DeleteRemoteHost(rhId))
+
+  suspend fun storeRemoteFile(rhId: Long, storeEncrypted: Boolean?, localPath: String): CryptoFile? {
+    val r = sendCmd(CC.StoreRemoteFile(rhId, storeEncrypted, localPath))
+    if (r is CR.RemoteFileStored) return r.remoteFileSource
+    apiErrorAlert("storeRemoteFile", generalGetString(MR.strings.error_alert_title), r)
+    return null
+  }
+
+  suspend fun getRemoteFile(rhId: Long, file: RemoteFile): Boolean = sendCommandOkResp(CC.GetRemoteFile(rhId, file))
+
+  suspend fun connectRemoteCtrl(invitation: String): SomeRemoteCtrl? {
+    val r = sendCmd(CC.ConnectRemoteCtrl(invitation))
+    if (r is CR.RemoteCtrlConnecting) return SomeRemoteCtrl(r.remoteCtrl_, r.ctrlAppInfo, r.appVersion)
+    apiErrorAlert("connectRemoteCtrl", generalGetString(MR.strings.error_alert_title), r)
+    return null
+  }
+
+  suspend fun findKnownRemoteCtrl(): Boolean = sendCommandOkResp(CC.FindKnownRemoteCtrl())
+
+  suspend fun confirmRemoteCtrl(rhId: Long): Boolean = sendCommandOkResp(CC.ConfirmRemoteCtrl(rhId))
+
+  suspend fun verifyRemoteCtrlSession(sessionCode: String): Boolean = sendCommandOkResp(CC.VerifyRemoteCtrlSession(sessionCode))
+
   suspend fun listRemoteCtrls(): List<RemoteCtrlInfo>? {
     val r = sendCmd(CC.ListRemoteCtrls())
     if (r is CR.RemoteCtrlList) return r.remoteCtrls
-    apiErrorAlert("listRemoteCtrls", generalGetString(MR.strings.error), r)
+    apiErrorAlert("listRemoteCtrls", generalGetString(MR.strings.error_alert_title), r)
     return null
   }
 
-  suspend fun stopRemoteHost(rhId: Long): Boolean = sendCommandOkResp(CC.StopRemoteHost(rhId))
-
-  suspend fun deleteRemoteHost(rhId: Long): Boolean = sendCommandOkResp(CC.DeleteRemoteHost(rhId))
-
-  suspend fun startRemoteCtrl(): Boolean = sendCommandOkResp(CC.StartRemoteCtrl())
-
-  suspend fun acceptRemoteCtrl(rcId: Long): Boolean = sendCommandOkResp(CC.AcceptRemoteCtrl(rcId))
-
-  suspend fun rejectRemoteCtrl(rcId: Long): Boolean = sendCommandOkResp(CC.RejectRemoteCtrl(rcId))
-
   suspend fun stopRemoteCtrl(): Boolean = sendCommandOkResp(CC.StopRemoteCtrl())
 
   suspend fun deleteRemoteCtrl(rcId: Long): Boolean = sendCommandOkResp(CC.DeleteRemoteCtrl(rcId))
@@ -1465,6 +1493,8 @@ object ChatController {
   private suspend fun processReceivedMsg(apiResp: APIResponse) {
     lastMsgReceivedTimestamp = System.currentTimeMillis()
     val r = apiResp.resp
+    val rhId = apiResp.remoteHostId
+    fun active(user: UserLike): Boolean = activeUser(rhId, user)
     chatModel.addTerminalItem(TerminalItem.resp(r))
     when (r) {
       is CR.NewContactConnection -> {
@@ -1577,7 +1607,7 @@ object ChatController {
             ((mc is MsgContent.MCImage && file.fileSize <= MAX_IMAGE_SIZE_AUTO_RCV)
                 || (mc is MsgContent.MCVideo && file.fileSize <= MAX_VIDEO_SIZE_AUTO_RCV)
                 || (mc is MsgContent.MCVoice && file.fileSize <= MAX_VOICE_SIZE_AUTO_RCV && file.fileStatus !is CIFileStatus.RcvAccepted))) {
-          withApi { receiveFile(r.user, file.fileId, encrypted = cItem.encryptLocalFile && chatController.appPrefs.privacyEncryptLocalFiles.get(), auto = true) }
+          withApi { receiveFile(rhId, r.user, file.fileId, encrypted = cItem.encryptLocalFile && chatController.appPrefs.privacyEncryptLocalFiles.get(), auto = true) }
         }
         if (cItem.showNotification && (allowedToShowNotification() || chatModel.chatId.value != cInfo.id)) {
           ntfManager.notifyMessageReceived(r.user, cInfo, cItem)
@@ -1591,7 +1621,7 @@ object ChatController {
         }
       }
       is CR.ChatItemUpdated ->
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
       is CR.ChatItemReaction -> {
         if (active(r.user)) {
           chatModel.updateChatItem(r.reaction.chatInfo, r.reaction.chatReaction.chatItem)
@@ -1703,37 +1733,37 @@ object ChatController {
           chatModel.updateContact(r.contact)
         }
       is CR.RcvFileStart ->
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
       is CR.RcvFileComplete ->
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
       is CR.RcvFileSndCancelled -> {
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
         cleanupFile(r.chatItem)
       }
       is CR.RcvFileProgressXFTP ->
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
       is CR.RcvFileError -> {
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
         cleanupFile(r.chatItem)
       }
       is CR.SndFileStart ->
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
       is CR.SndFileComplete -> {
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
         cleanupDirectFile(r.chatItem)
       }
       is CR.SndFileRcvCancelled -> {
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
         cleanupDirectFile(r.chatItem)
       }
       is CR.SndFileProgressXFTP ->
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
       is CR.SndFileCompleteXFTP -> {
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
         cleanupFile(r.chatItem)
       }
       is CR.SndFileError -> {
-        chatItemSimpleUpdate(r.user, r.chatItem)
+        chatItemSimpleUpdate(rhId, r.user, r.chatItem)
         cleanupFile(r.chatItem)
       }
       is CR.CallInvitation -> {
@@ -1789,12 +1819,18 @@ object ChatController {
         chatModel.updateContactConnectionStats(r.contact, r.ratchetSyncProgress.connectionStats)
       is CR.GroupMemberRatchetSync ->
         chatModel.updateGroupMemberConnectionStats(r.groupInfo, r.member, r.ratchetSyncProgress.connectionStats)
+      is CR.RemoteHostSessionCode -> {
+        chatModel.newRemoteHostPairing.value = r.remoteHost_ to RemoteHostSessionState.PendingConfirmation(r.sessionCode)
+      }
       is CR.RemoteHostConnected -> {
-        // update
-        chatModel.connectingRemoteHost.value = r.remoteHost
+        // TODO needs to update it instead in sessions
+        chatModel.currentRemoteHost.value = r.remoteHost
+        switchUIRemoteHost(r.remoteHost.remoteHostId)
       }
       is CR.RemoteHostStopped -> {
-        //
+        chatModel.currentRemoteHost.value = null
+        chatModel.newRemoteHostPairing.value = null
+        switchUIRemoteHost(null)
       }
       else ->
         Log.d(TAG , "unsupported event: ${r.responseType}")
@@ -1819,7 +1855,8 @@ object ChatController {
     }
   }
 
-  private fun active(user: UserLike): Boolean = user.userId == chatModel.currentUser.value?.userId
+  private fun activeUser(rhId: Long?, user: UserLike): Boolean =
+    rhId == chatModel.currentRemoteHost.value?.remoteHostId && user.userId == chatModel.currentUser.value?.userId
 
   private fun withCall(r: CR, contact: Contact, perform: (Call) -> Unit) {
     val call = chatModel.activeCall.value
@@ -1830,10 +1867,10 @@ object ChatController {
     }
   }
 
-  suspend fun receiveFile(user: UserLike, fileId: Long, encrypted: Boolean, auto: Boolean = false) {
+  suspend fun receiveFile(rhId: Long?, user: UserLike, fileId: Long, encrypted: Boolean, auto: Boolean = false) {
     val chatItem = apiReceiveFile(fileId, encrypted = encrypted, auto = auto)
     if (chatItem != null) {
-      chatItemSimpleUpdate(user, chatItem)
+      chatItemSimpleUpdate(rhId, user, chatItem)
     }
   }
 
@@ -1844,11 +1881,11 @@ object ChatController {
     }
   }
 
-  private suspend fun chatItemSimpleUpdate(user: UserLike, aChatItem: AChatItem) {
+  private suspend fun chatItemSimpleUpdate(rhId: Long?, user: UserLike, aChatItem: AChatItem) {
     val cInfo = aChatItem.chatInfo
     val cItem = aChatItem.chatItem
     val notify = { ntfManager.notifyMessageReceived(user, cInfo, cItem) }
-    if (!active(user)) {
+    if (!activeUser(rhId, user)) {
       notify()
     } else if (chatModel.upsertChatItem(cInfo, cItem)) {
       notify()
@@ -1876,6 +1913,25 @@ object ChatController {
     chatModel.setContactNetworkStatus(contact, NetworkStatus.Error(err))
   }
 
+  suspend fun switchUIRemoteHost(rhId: Long?) {
+    chatModel.chatId.value = null
+    chatModel.currentRemoteHost.value = switchRemoteHost(rhId)
+    reloadRemoteHosts()
+    val user = apiGetActiveUser()
+    val users = listUsers()
+    chatModel.users.clear()
+    chatModel.users.addAll(users)
+    chatModel.currentUser.value = user
+    chatModel.userCreated.value = true
+    val statuses = apiGetNetworkStatuses()
+    if (statuses != null) {
+      chatModel.networkStatuses.clear()
+      val ss = statuses.associate { it.agentConnId to it.networkStatus }.toMap()
+      chatModel.networkStatuses.putAll(ss)
+    }
+    getUserChatData()
+  }
+
   fun getXFTPCfg(): XFTPFileConfig {
     return XFTPFileConfig(minFileSize = 0)
   }
@@ -2059,19 +2115,23 @@ sealed class CC {
   class ApiChatUnread(val type: ChatType, val id: Long, val unreadChat: Boolean): CC()
   class ReceiveFile(val fileId: Long, val encrypt: Boolean, val inline: Boolean?): CC()
   class CancelFile(val fileId: Long): CC()
+  // Remote control
   class SetLocalDeviceName(val displayName: String): CC()
-  class CreateRemoteHost(): CC()
   class ListRemoteHosts(): CC()
-  class StartRemoteHost(val remoteHostId: Long): CC()
-  class StopRemoteHost(val remoteHostId: Long): CC()
+  class StartRemoteHost(val remoteHostId: Long?, val multicast: Boolean): CC()
+  class SwitchRemoteHost (val remoteHostId: Long?): CC()
+  class StopRemoteHost(val remoteHostKey: Long?): CC()
   class DeleteRemoteHost(val remoteHostId: Long): CC()
-  class StartRemoteCtrl(): CC()
-  class RegisterRemoteCtrl(val remoteCtrlOOB: RemoteCtrlOOB): CC()
+  class StoreRemoteFile(val remoteHostId: Long, val storeEncrypted: Boolean?, val localPath: String): CC()
+  class GetRemoteFile(val remoteHostId: Long, val file: RemoteFile): CC()
+  class ConnectRemoteCtrl(val xrcpInvitation: String): CC()
+  class FindKnownRemoteCtrl(): CC()
+  class ConfirmRemoteCtrl(val remoteCtrlId: Long): CC()
+  class VerifyRemoteCtrlSession(val sessionCode: String): CC()
   class ListRemoteCtrls(): CC()
-  class AcceptRemoteCtrl(val remoteCtrlId: Long): CC()
-  class RejectRemoteCtrl(val remoteCtrlId: Long): CC()
   class StopRemoteCtrl(): CC()
   class DeleteRemoteCtrl(val remoteCtrlId: Long): CC()
+  // misc
   class ShowVersion(): CC()
 
   val cmdString: String get() = when (this) {
@@ -2192,15 +2252,20 @@ sealed class CC {
           (if (inline == null) "" else " inline=${onOff(inline)}")
     is CancelFile -> "/fcancel $fileId"
     is SetLocalDeviceName -> "/set device name $displayName"
-    is CreateRemoteHost -> "/create remote host"
     is ListRemoteHosts -> "/list remote hosts"
-    is StartRemoteHost -> "/start remote host $remoteHostId"
-    is StopRemoteHost -> "/stop remote host $remoteHostId"
+    is StartRemoteHost -> "/start remote host " + if (remoteHostId == null) "new" else "$remoteHostId multicast=${onOff(multicast)}"
+    is SwitchRemoteHost -> "/switch remote host " + if (remoteHostId == null) "local" else "$remoteHostId"
+    is StopRemoteHost -> "/stop remote host " + if (remoteHostKey == null) "new" else "$remoteHostKey"
     is DeleteRemoteHost -> "/delete remote host $remoteHostId"
-    is StartRemoteCtrl -> "/start remote ctrl"
-    is RegisterRemoteCtrl -> "/register remote ctrl ${remoteCtrlOOB.fingerprint}"
-    is AcceptRemoteCtrl -> "/accept remote ctrl $remoteCtrlId"
-    is RejectRemoteCtrl -> "/reject remote ctrl $remoteCtrlId"
+    is StoreRemoteFile ->
+      "/store remote file $remoteHostId " +
+          (if (storeEncrypted == null) "" else " encrypt=${onOff(storeEncrypted)}") +
+          localPath
+    is GetRemoteFile -> "/get remote file $remoteHostId ${json.encodeToString(file)}"
+    is ConnectRemoteCtrl -> "/connect remote ctrl $xrcpInvitation"
+    is FindKnownRemoteCtrl -> "/find remote ctrl"
+    is ConfirmRemoteCtrl -> "/confirm remote ctrl $remoteCtrlId"
+    is VerifyRemoteCtrlSession -> "/verify remote ctrl $sessionCode"
     is ListRemoteCtrls -> "/list remote ctrls"
     is StopRemoteCtrl -> "/stop remote ctrl"
     is DeleteRemoteCtrl -> "/delete remote ctrl $remoteCtrlId"
@@ -2306,16 +2371,18 @@ sealed class CC {
     is ReceiveFile -> "receiveFile"
     is CancelFile -> "cancelFile"
     is SetLocalDeviceName -> "setLocalDeviceName"
-    is CreateRemoteHost -> "createRemoteHost"
     is ListRemoteHosts -> "listRemoteHosts"
     is StartRemoteHost -> "startRemoteHost"
+    is SwitchRemoteHost -> "switchRemoteHost"
     is StopRemoteHost -> "stopRemoteHost"
     is DeleteRemoteHost -> "deleteRemoteHost"
-    is StartRemoteCtrl -> "startRemoteCtrl"
-    is RegisterRemoteCtrl -> "registerRemoteCtrl"
+    is StoreRemoteFile -> "storeRemoteFile"
+    is GetRemoteFile -> "getRemoteFile"
+    is ConnectRemoteCtrl -> "connectRemoteCtrl"
+    is FindKnownRemoteCtrl -> "FindKnownRemoteCtrl"
+    is ConfirmRemoteCtrl -> "confirmRemoteCtrl"
+    is VerifyRemoteCtrlSession -> "verifyRemoteCtrlSession"
     is ListRemoteCtrls -> "listRemoteCtrls"
-    is AcceptRemoteCtrl -> "acceptRemoteCtrl"
-    is RejectRemoteCtrl -> "rejectRemoteCtrl"
     is StopRemoteCtrl -> "stopRemoteCtrl"
     is DeleteRemoteCtrl -> "deleteRemoteCtrl"
     is ShowVersion -> "showVersion"
@@ -3388,27 +3455,34 @@ data class RemoteCtrl (
   val accepted: Boolean?
 )
 
-@Serializable
-data class RemoteCtrlOOB (
-  val fingerprint: String,
-  val displayName: String
-)
-
 @Serializable
 data class RemoteCtrlInfo (
   val remoteCtrlId: Long,
-  val displayName: String,
-  val sessionActive: Boolean
+  val ctrlDeviceName: String,
+  val sessionState: RemoteCtrlSessionState?
 )
 
 @Serializable
-data class RemoteHostInfo (
+data class RemoteHostInfo(
   val remoteHostId: Long,
+  val hostDeviceName: String,
   val storePath: String,
-  val displayName: String,
-  val remoteCtrlOOB: RemoteCtrlOOB,
-  val sessionActive: Boolean
-)
+  val sessionState: RemoteHostSessionState?
+) {
+  val activeHost: Boolean
+    @Composable get() = chatModel.currentRemoteHost.value?.remoteHostId == remoteHostId
+
+  fun activeHost(): Boolean = chatModel.currentRemoteHost.value?.remoteHostId == remoteHostId
+}
+
+@Serializable
+sealed class RemoteHostSessionState {
+  @Serializable @SerialName("starting") object Starting: RemoteHostSessionState()
+  @Serializable @SerialName("connecting") class Connecting(val invitation: String): RemoteHostSessionState()
+  @Serializable @SerialName("pendingConfirmation") class PendingConfirmation(val sessionCode: String): RemoteHostSessionState()
+  @Serializable @SerialName("confirmed") data class Confirmed(val sessionCode: String): RemoteHostSessionState()
+  @Serializable @SerialName("connected") data class Connected(val sessionCode: String): RemoteHostSessionState()
+}
 
 val json = Json {
   prettyPrint = true
@@ -3621,16 +3695,19 @@ sealed class CR {
   @Serializable @SerialName("newContactConnection") class NewContactConnection(val user: UserRef, val connection: PendingContactConnection): CR()
   @Serializable @SerialName("contactConnectionDeleted") class ContactConnectionDeleted(val user: UserRef, val connection: PendingContactConnection): CR()
   // remote events (desktop)
-  @Serializable @SerialName("remoteHostCreated") class RemoteHostCreated(val remoteHost: RemoteHostInfo): CR()
   @Serializable @SerialName("remoteHostList") class RemoteHostList(val remoteHosts: List<RemoteHostInfo>): CR()
+  @Serializable @SerialName("currentRemoteHost") class CurrentRemoteHost(val remoteHost_: RemoteHostInfo?): CR()
+  @Serializable @SerialName("remoteHostStarted") class RemoteHostStarted(val remoteHost_: RemoteHostInfo?, val invitation: String): CR()
+  @Serializable @SerialName("remoteHostSessionCode") class RemoteHostSessionCode(val remoteHost_: RemoteHostInfo?, val sessionCode: String): CR()
+  @Serializable @SerialName("newRemoteHost") class NewRemoteHost(val remoteHost: RemoteHostInfo): CR()
   @Serializable @SerialName("remoteHostConnected") class RemoteHostConnected(val remoteHost: RemoteHostInfo): CR()
-  @Serializable @SerialName("remoteHostStopped") class RemoteHostStopped(val remoteHostId: Long): CR()
+  @Serializable @SerialName("remoteHostStopped") class RemoteHostStopped(val remoteHostId_: Long?): CR()
+  @Serializable @SerialName("remoteFileStored") class RemoteFileStored(val remoteHostId: Long, val remoteFileSource: CryptoFile): CR()
   // remote events (mobile)
   @Serializable @SerialName("remoteCtrlList") class RemoteCtrlList(val remoteCtrls: List<RemoteCtrlInfo>): CR()
-  @Serializable @SerialName("remoteCtrlRegistered") class RemoteCtrlRegistered(val remoteCtrl: RemoteCtrlInfo): CR()
-  @Serializable @SerialName("remoteCtrlAnnounce") class RemoteCtrlAnnounce(val fingerprint: String): CR()
   @Serializable @SerialName("remoteCtrlFound") class RemoteCtrlFound(val remoteCtrl: RemoteCtrlInfo): CR()
-  @Serializable @SerialName("remoteCtrlConnecting") class RemoteCtrlConnecting(val remoteCtrl: RemoteCtrlInfo): CR()
+  @Serializable @SerialName("remoteCtrlConnecting") class RemoteCtrlConnecting(val remoteCtrl_: RemoteCtrlInfo?, val ctrlAppInfo: CtrlAppInfo, val appVersion: String): CR()
+  @Serializable @SerialName("remoteCtrlSessionCode") class RemoteCtrlSessionCode(val remoteCtrl_: RemoteCtrlInfo?, val sessionCode: String): CR()
   @Serializable @SerialName("remoteCtrlConnected") class RemoteCtrlConnected(val remoteCtrl: RemoteCtrlInfo): CR()
   @Serializable @SerialName("remoteCtrlStopped") class RemoteCtrlStopped(): CR()
   @Serializable @SerialName("versionInfo") class VersionInfo(val versionInfo: CoreVersionInfo, val chatMigrations: List<UpMigration>, val agentMigrations: List<UpMigration>): CR()
@@ -3767,15 +3844,18 @@ sealed class CR {
     is CallEnded -> "callEnded"
     is NewContactConnection -> "newContactConnection"
     is ContactConnectionDeleted -> "contactConnectionDeleted"
-    is RemoteHostCreated -> "remoteHostCreated"
     is RemoteHostList -> "remoteHostList"
+    is CurrentRemoteHost -> "currentRemoteHost"
+    is RemoteHostStarted -> "remoteHostStarted"
+    is RemoteHostSessionCode -> "remoteHostSessionCode"
+    is NewRemoteHost -> "newRemoteHost"
     is RemoteHostConnected -> "remoteHostConnected"
     is RemoteHostStopped -> "remoteHostStopped"
+    is RemoteFileStored -> "remoteFileStored"
     is RemoteCtrlList -> "remoteCtrlList"
-    is RemoteCtrlRegistered -> "remoteCtrlRegistered"
-    is RemoteCtrlAnnounce -> "remoteCtrlAnnounce"
     is RemoteCtrlFound -> "remoteCtrlFound"
     is RemoteCtrlConnecting -> "remoteCtrlConnecting"
+    is RemoteCtrlSessionCode -> "remoteCtrlSessionCode"
     is RemoteCtrlConnected -> "remoteCtrlConnected"
     is RemoteCtrlStopped -> "remoteCtrlStopped"
     is VersionInfo -> "versionInfo"
@@ -3912,15 +3992,29 @@ sealed class CR {
     is CallEnded -> withUser(user, "contact: ${contact.id}")
     is NewContactConnection -> withUser(user, json.encodeToString(connection))
     is ContactConnectionDeleted -> withUser(user, json.encodeToString(connection))
-    is RemoteHostCreated -> json.encodeToString(remoteHost)
+    // remote events (mobile)
     is RemoteHostList -> json.encodeToString(remoteHosts)
+    is CurrentRemoteHost -> if (remoteHost_ == null) "local" else json.encodeToString(remoteHost_)
+    is RemoteHostStarted -> if (remoteHost_ == null) "new" else json.encodeToString(remoteHost_)
+    is RemoteHostSessionCode ->
+      "remote host: " +
+          (if (remoteHost_ == null) "new" else json.encodeToString(remoteHost_)) +
+          "\nsession code: $sessionCode"
+    is NewRemoteHost -> json.encodeToString(remoteHost)
     is RemoteHostConnected -> json.encodeToString(remoteHost)
-    is RemoteHostStopped -> "remote host ID: $remoteHostId"
+    is RemoteHostStopped -> "remote host ID: $remoteHostId_"
+    is RemoteFileStored -> "remote host ID: $remoteHostId\nremoteFileSource:\n" + json.encodeToString(remoteFileSource)
     is RemoteCtrlList -> json.encodeToString(remoteCtrls)
-    is RemoteCtrlRegistered -> json.encodeToString(remoteCtrl)
-    is RemoteCtrlAnnounce -> "fingerprint: $fingerprint"
     is RemoteCtrlFound -> json.encodeToString(remoteCtrl)
-    is RemoteCtrlConnecting -> json.encodeToString(remoteCtrl)
+    is RemoteCtrlConnecting ->
+      "remote ctrl: " +
+          (if (remoteCtrl_ == null) "null" else json.encodeToString(remoteCtrl_)) +
+          "\nctrlAppInfo:\n${json.encodeToString(ctrlAppInfo)}" +
+          "\nappVersion: $appVersion"
+    is RemoteCtrlSessionCode ->
+      "remote ctrl: " +
+          (if (remoteCtrl_ == null) "null" else json.encodeToString(remoteCtrl_)) +
+          "\nsessionCode: $sessionCode"
     is RemoteCtrlConnected -> json.encodeToString(remoteCtrl)
     is RemoteCtrlStopped -> noDetails()
     is VersionInfo -> "version ${json.encodeToString(versionInfo)}\n\n" +
@@ -4102,6 +4196,26 @@ data class CoreVersionInfo(
   val simplexmqCommit: String
 )
 
+data class SomeRemoteCtrl(
+  val remoteCtrl_: RemoteCtrlInfo?,
+  val ctrlAppInfo: CtrlAppInfo,
+  val appVersion: String
+)
+
+@Serializable
+data class CtrlAppInfo(val appVersionRange: AppVersionRange, val deviceName: String)
+
+@Serializable
+data class AppVersionRange(val minVersion: String, val maxVersion: String)
+
+@Serializable
+data class RemoteFile(
+  val userId: Long,
+  val fileId: Long,
+  val sent: Boolean,
+  val fileSource: CryptoFile
+)
+
 @Serializable
 sealed class ChatError {
   val string: String get() = when (this) {
@@ -4624,18 +4738,20 @@ sealed class ArchiveError {
 sealed class RemoteHostError {
   val string: String get() = when (this) {
     is Missing -> "missing"
+    is Inactive -> "inactive"
     is Busy -> "busy"
-    is Rejected -> "rejected"
     is Timeout -> "timeout"
+    is BadState -> "badState"
+    is BadVersion -> "badVersion"
     is Disconnected -> "disconnected"
-    is ConnectionLost -> "connectionLost"
   }
   @Serializable @SerialName("missing") object Missing: RemoteHostError()
+  @Serializable @SerialName("inactive") object Inactive: RemoteHostError()
   @Serializable @SerialName("busy") object Busy: RemoteHostError()
-  @Serializable @SerialName("rejected") object Rejected: RemoteHostError()
   @Serializable @SerialName("timeout") object Timeout: RemoteHostError()
+  @Serializable @SerialName("badState") object BadState: RemoteHostError()
+  @Serializable @SerialName("badVersion") object BadVersion: RemoteHostError()
   @Serializable @SerialName("disconnected") class Disconnected(val reason: String): RemoteHostError()
-  @Serializable @SerialName("connectionLost") class ConnectionLost(val reason: String): RemoteHostError()
 }
 
 @Serializable
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt
index 2bed24b1f..c32137ee6 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt
@@ -15,6 +15,7 @@ external fun pipeStdOutToSocket(socketName: String) : Int
 typealias ChatCtrl = Long
 external fun chatMigrateInit(dbPath: String, dbKey: String, confirm: String): Array<Any>
 external fun chatSendCmd(ctrl: ChatCtrl, msg: String): String
+external fun chatSendRemoteCmd(ctrl: ChatCtrl, rhId: Int, msg: String): String
 external fun chatRecvMsg(ctrl: ChatCtrl): String
 external fun chatRecvMsgWait(ctrl: ChatCtrl, timeout: Int): String
 external fun chatParseMarkdown(str: String): String
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt
index 42e43f7b7..2d526c513 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt
@@ -46,6 +46,7 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
   val activeChat = remember { mutableStateOf(chatModel.chats.firstOrNull { chat -> chat.chatInfo.id == chatId }) }
   val searchText = rememberSaveable { mutableStateOf("") }
   val user = chatModel.currentUser.value
+  val rhId = remember { chatModel.currentRemoteHost }.value?.remoteHostId
   val useLinkPreviews = chatModel.controller.appPrefs.privacyLinkPreviews.get()
   val composeState = rememberSaveable(saver = ComposeState.saver()) {
     mutableStateOf(
@@ -284,10 +285,10 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
         }
       },
       receiveFile = { fileId, encrypted ->
-        withApi { chatModel.controller.receiveFile(user, fileId, encrypted) }
+        withApi { chatModel.controller.receiveFile(rhId, user, fileId, encrypted) }
       },
       cancelFile = { fileId ->
-        withApi { chatModel.controller.cancelFile(user, fileId) }
+        withApi { chatModel.controller.cancelFile(rhId, user, fileId) }
       },
       joinGroup = { groupId, onComplete ->
         withApi {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt
index fdf361bf6..095723a18 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt
@@ -590,7 +590,7 @@ private fun ShrinkItemAction(revealed: MutableState<Boolean>, showMenu: MutableS
 }
 
 @Composable
-fun ItemAction(text: String, icon: Painter, onClick: () -> Unit, color: Color = Color.Unspecified) {
+fun ItemAction(text: String, icon: Painter, color: Color = Color.Unspecified, onClick: () -> Unit) {
   val finalColor = if (color == Color.Unspecified) {
     if (isInDarkTheme()) MenuTextColorDark else Color.Black
   } else color
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt
index 7af4d2670..7883a7a73 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt
@@ -1,6 +1,5 @@
 package chat.simplex.common.views.chatlist
 
-import SectionItemView
 import androidx.compose.foundation.*
 import androidx.compose.foundation.layout.*
 import androidx.compose.foundation.lazy.*
@@ -9,30 +8,22 @@ import androidx.compose.foundation.shape.RoundedCornerShape
 import androidx.compose.material.*
 import androidx.compose.runtime.*
 import androidx.compose.runtime.saveable.rememberSaveable
-import androidx.compose.runtime.snapshots.SnapshotStateList
 import androidx.compose.ui.Alignment
 import androidx.compose.ui.Modifier
-import androidx.compose.ui.draw.clip
 import androidx.compose.ui.graphics.*
-import androidx.compose.ui.platform.LocalUriHandler
-import androidx.compose.ui.text.AnnotatedString
 import dev.icerock.moko.resources.compose.painterResource
 import dev.icerock.moko.resources.compose.stringResource
 import androidx.compose.ui.text.font.FontWeight
-import androidx.compose.ui.text.style.TextAlign
 import androidx.compose.ui.unit.*
 import chat.simplex.common.SettingsViewState
 import chat.simplex.common.model.*
+import chat.simplex.common.model.ChatController.stopRemoteHostAndReloadHosts
 import chat.simplex.common.ui.theme.*
 import chat.simplex.common.views.helpers.*
 import chat.simplex.common.views.onboarding.WhatsNewView
 import chat.simplex.common.views.onboarding.shouldShowWhatsNew
 import chat.simplex.common.views.usersettings.SettingsView
-import chat.simplex.common.views.usersettings.simplexTeamUri
 import chat.simplex.common.platform.*
-import chat.simplex.common.views.call.Call
-import chat.simplex.common.views.call.CallMediaType
-import chat.simplex.common.views.chat.item.ItemAction
 import chat.simplex.common.views.newchat.*
 import chat.simplex.res.MR
 import kotlinx.coroutines.*
@@ -77,7 +68,7 @@ fun ChatListView(chatModel: ChatModel, settingsState: SettingsViewState, setPerf
   val endPadding = if (appPlatform.isDesktop) 56.dp else 0.dp
   var searchInList by rememberSaveable { mutableStateOf("") }
   val scope = rememberCoroutineScope()
-  val (userPickerState, scaffoldState, switchingUsers ) = settingsState
+  val (userPickerState, scaffoldState, switchingUsersAndHosts ) = settingsState
   Scaffold(topBar = { Box(Modifier.padding(end = endPadding)) { ChatListToolbar(chatModel, scaffoldState.drawerState, userPickerState, stopped) { searchInList = it.trim() } } },
     scaffoldState = scaffoldState,
     drawerContent = { SettingsView(chatModel, setPerformLA, scaffoldState.drawerState) },
@@ -113,7 +104,7 @@ fun ChatListView(chatModel: ChatModel, settingsState: SettingsViewState, setPerf
       ) {
         if (chatModel.chats.isNotEmpty()) {
           ChatList(chatModel, search = searchInList)
-        } else if (!switchingUsers.value) {
+        } else if (!switchingUsersAndHosts.value) {
           Box(Modifier.fillMaxSize()) {
             if (!stopped && !newChatSheetState.collectAsState().value.isVisible()) {
               OnboardingButtons(showNewChatSheet)
@@ -129,11 +120,12 @@ fun ChatListView(chatModel: ChatModel, settingsState: SettingsViewState, setPerf
     NewChatSheet(chatModel, newChatSheetState, stopped, hideNewChatSheet)
   }
   if (appPlatform.isAndroid) {
-    UserPicker(chatModel, userPickerState, switchingUsers) {
+    UserPicker(chatModel, userPickerState, switchingUsersAndHosts) {
       scope.launch { if (scaffoldState.drawerState.isOpen) scaffoldState.drawerState.close() else scaffoldState.drawerState.open() }
+      userPickerState.value = AnimatedViewState.GONE
     }
   }
-  if (switchingUsers.value) {
+  if (switchingUsersAndHosts.value) {
     Box(
       Modifier.fillMaxSize().clickable(enabled = false, onClick = {}),
       contentAlignment = Alignment.Center
@@ -224,7 +216,7 @@ private fun ChatListToolbar(chatModel: ChatModel, drawerState: DrawerState, user
           .filter { u -> !u.user.activeUser && !u.user.hidden }
           .all { u -> u.unreadCount == 0 }
         UserProfileButton(chatModel.currentUser.value?.profile?.image, allRead) {
-          if (users.size == 1) {
+          if (users.size == 1 && chatModel.remoteHosts.isEmpty()) {
             scope.launch { drawerState.open() }
           } else {
             userPickerState.value = AnimatedViewState.VISIBLE
@@ -254,14 +246,25 @@ private fun ChatListToolbar(chatModel: ChatModel, drawerState: DrawerState, user
 
 @Composable
 fun UserProfileButton(image: String?, allRead: Boolean, onButtonClicked: () -> Unit) {
-  IconButton(onClick = onButtonClicked) {
-    Box {
-      ProfileImage(
-        image = image,
-        size = 37.dp
-      )
-      if (!allRead) {
-        unreadBadge()
+  Row(verticalAlignment = Alignment.CenterVertically) {
+    IconButton(onClick = onButtonClicked) {
+      Box {
+        ProfileImage(
+          image = image,
+          size = 37.dp
+        )
+        if (!allRead) {
+          unreadBadge()
+        }
+      }
+    }
+    if (appPlatform.isDesktop) {
+      val h by remember { chatModel.currentRemoteHost }
+      if (h != null) {
+        Spacer(Modifier.width(12.dp))
+        HostDisconnectButton {
+          stopRemoteHostAndReloadHosts(h!!, true)
+        }
       }
     }
   }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListView.kt
index 8b65b2b5b..ecd47c937 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListView.kt
@@ -26,7 +26,7 @@ import kotlinx.coroutines.flow.MutableStateFlow
 @Composable
 fun ShareListView(chatModel: ChatModel, settingsState: SettingsViewState, stopped: Boolean) {
   var searchInList by rememberSaveable { mutableStateOf("") }
-  val (userPickerState, scaffoldState, switchingUsers) = settingsState
+  val (userPickerState, scaffoldState, switchingUsersAndHosts) = settingsState
   val endPadding = if (appPlatform.isDesktop) 56.dp else 0.dp
   Scaffold(
     Modifier.padding(end = endPadding),
@@ -47,8 +47,9 @@ fun ShareListView(chatModel: ChatModel, settingsState: SettingsViewState, stoppe
     }
   }
   if (appPlatform.isAndroid) {
-    UserPicker(chatModel, userPickerState, switchingUsers, showSettings = false, showCancel = true, cancelClicked = {
+    UserPicker(chatModel, userPickerState, switchingUsersAndHosts, showSettings = false, showCancel = true, cancelClicked = {
       chatModel.sharedContent.value = null
+      userPickerState.value = AnimatedViewState.GONE
     })
   }
 }
@@ -72,7 +73,7 @@ private fun ShareListToolbar(chatModel: ChatModel, userPickerState: MutableState
   val navButton: @Composable RowScope.() -> Unit = {
     when {
       showSearch -> NavigationButtonBack(hideSearchOnBack)
-      users.size > 1 -> {
+      users.size > 1 || chatModel.remoteHosts.isNotEmpty() -> {
         val allRead = users
           .filter { u -> !u.user.activeUser && !u.user.hidden }
           .all { u -> u.unreadCount == 0 }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt
index 8c7dc2c60..66cac7204 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt
@@ -4,10 +4,12 @@ import SectionItemView
 import androidx.compose.animation.core.*
 import androidx.compose.foundation.*
 import androidx.compose.foundation.interaction.MutableInteractionSource
+import androidx.compose.foundation.interaction.collectIsHoveredAsState
 import androidx.compose.foundation.layout.*
 import androidx.compose.foundation.shape.*
 import androidx.compose.material.*
 import androidx.compose.runtime.*
+import androidx.compose.runtime.saveable.rememberSaveable
 import androidx.compose.ui.*
 import androidx.compose.ui.draw.*
 import androidx.compose.ui.graphics.Color
@@ -18,12 +20,15 @@ import androidx.compose.ui.text.capitalize
 import androidx.compose.ui.text.font.FontWeight
 import androidx.compose.ui.text.intl.Locale
 import androidx.compose.ui.unit.*
+import chat.simplex.common.model.*
+import chat.simplex.common.model.ChatController.stopRemoteHostAndReloadHosts
+import chat.simplex.common.model.ChatModel.controller
 import chat.simplex.common.ui.theme.*
 import chat.simplex.common.views.helpers.*
-import chat.simplex.common.model.ChatModel
-import chat.simplex.common.model.User
 import chat.simplex.common.platform.*
+import chat.simplex.common.views.remote.connectMobileDevice
 import chat.simplex.res.MR
+import dev.icerock.moko.resources.compose.stringResource
 import kotlinx.coroutines.delay
 import kotlinx.coroutines.flow.*
 import kotlinx.coroutines.launch
@@ -33,7 +38,7 @@ import kotlin.math.roundToInt
 fun UserPicker(
   chatModel: ChatModel,
   userPickerState: MutableStateFlow<AnimatedViewState>,
-  switchingUsers: MutableState<Boolean>,
+  switchingUsersAndHosts: MutableState<Boolean>,
   showSettings: Boolean = true,
   showCancel: Boolean = false,
   cancelClicked: () -> Unit = {},
@@ -53,6 +58,12 @@ fun UserPicker(
         .sortedByDescending { it.user.activeUser }
     }
   }
+  val remoteHosts by remember {
+    derivedStateOf {
+      chatModel.remoteHosts
+        .sortedBy { it.hostDeviceName }
+    }
+  }
   val animatedFloat = remember { Animatable(if (newChat.isVisible()) 0f else 1f) }
   LaunchedEffect(Unit) {
     launch {
@@ -90,8 +101,42 @@ fun UserPicker(
         } catch (e: Exception) {
           Log.e(TAG, "Error updating users ${e.stackTraceToString()}")
         }
+        if (!appPlatform.isDesktop) return@collect
+        try {
+          val updatedHosts = chatModel.controller.listRemoteHosts()?.sortedBy { it.hostDeviceName } ?: emptyList()
+          if (remoteHosts != updatedHosts) {
+            chatModel.remoteHosts.clear()
+            chatModel.remoteHosts.addAll(updatedHosts)
+          }
+        } catch (e: Exception) {
+          Log.e(TAG, "Error updating remote hosts ${e.stackTraceToString()}")
+        }
       }
   }
+  LaunchedEffect(Unit) {
+    controller.reloadRemoteHosts()
+  }
+  val UsersView: @Composable ColumnScope.() -> Unit = {
+    users.forEach { u ->
+      UserProfilePickerItem(u.user, u.unreadCount, openSettings = settingsClicked) {
+        userPickerState.value = AnimatedViewState.HIDING
+        if (!u.user.activeUser) {
+          scope.launch {
+            val job = launch {
+              delay(500)
+              switchingUsersAndHosts.value = true
+            }
+            ModalManager.closeAllModalsEverywhere()
+            chatModel.controller.changeActiveUser(u.user.userId, null)
+            job.cancel()
+            switchingUsersAndHosts.value = false
+          }
+        }
+      }
+      Divider(Modifier.requiredHeight(1.dp))
+      if (u.user.activeUser) Divider(Modifier.requiredHeight(0.5.dp))
+    }
+  }
   val xOffset = with(LocalDensity.current) { 10.dp.roundToPx() }
   val maxWidth = with(LocalDensity.current) { windowWidth() * density }
   Box(Modifier
@@ -113,48 +158,63 @@ fun UserPicker(
         .background(MaterialTheme.colors.surface, RoundedCornerShape(corner = CornerSize(25.dp)))
         .clip(RoundedCornerShape(corner = CornerSize(25.dp)))
     ) {
+      val currentRemoteHost = remember { chatModel.currentRemoteHost }.value
       Column(Modifier.weight(1f).verticalScroll(rememberScrollState())) {
-        users.forEach { u ->
-          UserProfilePickerItem(u.user, u.unreadCount, PaddingValues(start = DEFAULT_PADDING_HALF, end = DEFAULT_PADDING), openSettings = {
-            settingsClicked()
-            userPickerState.value = AnimatedViewState.GONE
-          }) {
-            userPickerState.value = AnimatedViewState.HIDING
-            if (!u.user.activeUser) {
-              scope.launch {
-                val job = launch {
-                  delay(500)
-                  switchingUsers.value = true
-                }
-                ModalManager.closeAllModalsEverywhere()
-                chatModel.controller.changeActiveUser(u.user.userId, null)
-                job.cancel()
-                switchingUsers.value = false
-              }
+        if (remoteHosts.isNotEmpty()) {
+          if (currentRemoteHost == null) {
+            LocalDevicePickerItem(true) {
+              userPickerState.value = AnimatedViewState.HIDING
+              switchToLocalDevice()
             }
+            Divider(Modifier.requiredHeight(1.dp))
+          } else {
+            val connecting = rememberSaveable { mutableStateOf(false) }
+            RemoteHostPickerItem(currentRemoteHost,
+              actionButtonClick = {
+                userPickerState.value = AnimatedViewState.HIDING
+                stopRemoteHostAndReloadHosts(currentRemoteHost, true)
+              }) {
+                userPickerState.value = AnimatedViewState.HIDING
+                switchToRemoteHost(currentRemoteHost, switchingUsersAndHosts, connecting)
+              }
+            Divider(Modifier.requiredHeight(1.dp))
+          }
+        }
+
+        UsersView()
+
+        if (remoteHosts.isNotEmpty() && currentRemoteHost != null) {
+          LocalDevicePickerItem(false) {
+            userPickerState.value = AnimatedViewState.HIDING
+            switchToLocalDevice()
+          }
+          Divider(Modifier.requiredHeight(1.dp))
+        }
+        remoteHosts.filter { !it.activeHost }.forEach { h ->
+          val connecting = rememberSaveable { mutableStateOf(false) }
+          RemoteHostPickerItem(h,
+            actionButtonClick = {
+              userPickerState.value = AnimatedViewState.HIDING
+              stopRemoteHostAndReloadHosts(h, false)
+            }) {
+              userPickerState.value = AnimatedViewState.HIDING
+              switchToRemoteHost(h, switchingUsersAndHosts, connecting)
           }
           Divider(Modifier.requiredHeight(1.dp))
-          if (u.user.activeUser) Divider(Modifier.requiredHeight(0.5.dp))
         }
       }
       if (showSettings) {
-        SettingsPickerItem {
-          settingsClicked()
-          userPickerState.value = AnimatedViewState.GONE
-        }
+        SettingsPickerItem(settingsClicked)
       }
       if (showCancel) {
-        CancelPickerItem {
-          cancelClicked()
-          userPickerState.value = AnimatedViewState.GONE
-        }
+        CancelPickerItem(cancelClicked)
       }
     }
   }
 }
 
 @Composable
-fun UserProfilePickerItem(u: User, unreadCount: Int = 0, padding: PaddingValues = PaddingValues(start = DEFAULT_PADDING_HALF, end = DEFAULT_PADDING), onLongClick: () -> Unit = {}, openSettings: () -> Unit = {}, onClick: () -> Unit) {
+fun UserProfilePickerItem(u: User, unreadCount: Int = 0, onLongClick: () -> Unit = {}, openSettings: () -> Unit = {}, onClick: () -> Unit) {
   Row(
     Modifier
       .fillMaxWidth()
@@ -166,7 +226,7 @@ fun UserProfilePickerItem(u: User, unreadCount: Int = 0, padding: PaddingValues
         indication = if (!u.activeUser) LocalIndication.current else null
       )
       .onRightClick { onLongClick() }
-      .padding(padding),
+      .padding(start = DEFAULT_PADDING_HALF, end = DEFAULT_PADDING),
     horizontalArrangement = Arrangement.SpaceBetween,
     verticalAlignment = Alignment.CenterVertically
   ) {
@@ -219,16 +279,97 @@ fun UserProfileRow(u: User) {
   }
 }
 
+@Composable
+fun RemoteHostPickerItem(h: RemoteHostInfo, onLongClick: () -> Unit = {}, actionButtonClick: () -> Unit = {}, onClick: () -> Unit) {
+  Row(
+    Modifier
+      .fillMaxWidth()
+      .background(color = if (h.activeHost) MaterialTheme.colors.surface.mixWith(MaterialTheme.colors.onBackground, 0.95f) else Color.Unspecified)
+      .sizeIn(minHeight = 46.dp)
+      .combinedClickable(
+        onClick = onClick,
+        onLongClick = onLongClick
+      )
+      .onRightClick { onLongClick() }
+      .padding(start = DEFAULT_PADDING_HALF, end = DEFAULT_PADDING),
+    horizontalArrangement = Arrangement.SpaceBetween,
+    verticalAlignment = Alignment.CenterVertically
+  ) {
+    RemoteHostRow(h)
+    if (h.sessionState is RemoteHostSessionState.Connected) {
+      HostDisconnectButton(actionButtonClick)
+    } else {
+      Box(Modifier.size(20.dp))
+    }
+  }
+}
+
+@Composable
+fun RemoteHostRow(h: RemoteHostInfo) {
+  Row(
+    Modifier
+      .widthIn(max = windowWidth() * 0.7f)
+      .padding(start = 17.dp),
+    verticalAlignment = Alignment.CenterVertically
+  ) {
+    Icon(painterResource(MR.images.ic_smartphone_300), h.hostDeviceName, Modifier.size(20.dp), tint = MaterialTheme.colors.onBackground)
+    Text(
+      h.hostDeviceName,
+      modifier = Modifier.padding(start = 26.dp, end = 8.dp),
+      color = if (h.activeHost) MaterialTheme.colors.onBackground else if (isInDarkTheme()) MenuTextColorDark else Color.Black,
+      fontSize = 14.sp,
+    )
+  }
+}
+
+@Composable
+fun LocalDevicePickerItem(active: Boolean, onLongClick: () -> Unit = {}, onClick: () -> Unit) {
+  Row(
+    Modifier
+      .fillMaxWidth()
+      .background(color = if (active) MaterialTheme.colors.surface.mixWith(MaterialTheme.colors.onBackground, 0.95f) else Color.Unspecified)
+      .sizeIn(minHeight = 46.dp)
+      .combinedClickable(
+        onClick = if (active) {{}} else onClick,
+        onLongClick = onLongClick,
+        interactionSource = remember { MutableInteractionSource() },
+        indication = if (!active) LocalIndication.current else null
+      )
+      .onRightClick { onLongClick() }
+      .padding(start = DEFAULT_PADDING_HALF, end = DEFAULT_PADDING),
+    horizontalArrangement = Arrangement.SpaceBetween,
+    verticalAlignment = Alignment.CenterVertically
+  ) {
+    LocalDeviceRow(active)
+    Box(Modifier.size(20.dp))
+  }
+}
+
+@Composable
+fun LocalDeviceRow(active: Boolean) {
+  Row(
+    Modifier
+      .widthIn(max = windowWidth() * 0.7f)
+      .padding(start = 17.dp, end = DEFAULT_PADDING),
+    verticalAlignment = Alignment.CenterVertically
+  ) {
+    Icon(painterResource(MR.images.ic_desktop), stringResource(MR.strings.this_device), Modifier.size(20.dp), tint = MaterialTheme.colors.onBackground)
+    Text(
+      stringResource(MR.strings.this_device),
+      modifier = Modifier.padding(start = 26.dp, end = 8.dp),
+      color = if (active) MaterialTheme.colors.onBackground else if (isInDarkTheme()) MenuTextColorDark else Color.Black,
+      fontSize = 14.sp,
+    )
+  }
+}
+
 @Composable
 private fun SettingsPickerItem(onClick: () -> Unit) {
   SectionItemView(onClick, padding = PaddingValues(start = DEFAULT_PADDING + 7.dp, end = DEFAULT_PADDING), minHeight = 68.dp) {
     val text = generalGetString(MR.strings.settings_section_title_settings).lowercase().capitalize(Locale.current)
     Icon(painterResource(MR.images.ic_settings), text, Modifier.size(20.dp), tint = MaterialTheme.colors.onBackground)
     Spacer(Modifier.width(DEFAULT_PADDING + 6.dp))
-    Text(
-      text,
-      color = if (isInDarkTheme()) MenuTextColorDark else Color.Black,
-    )
+    Text(text, color = if (isInDarkTheme()) MenuTextColorDark else Color.Black)
   }
 }
 
@@ -238,9 +379,47 @@ private fun CancelPickerItem(onClick: () -> Unit) {
     val text = generalGetString(MR.strings.cancel_verb)
     Icon(painterResource(MR.images.ic_close), text, Modifier.size(20.dp), tint = MaterialTheme.colors.onBackground)
     Spacer(Modifier.width(DEFAULT_PADDING + 6.dp))
-    Text(
-      text,
-      color = if (isInDarkTheme()) MenuTextColorDark else Color.Black,
+    Text(text, color = if (isInDarkTheme()) MenuTextColorDark else Color.Black)
+  }
+}
+
+@Composable
+fun HostDisconnectButton(onClick: (() -> Unit)?) {
+  val interactionSource = remember { MutableInteractionSource() }
+  val hovered = interactionSource.collectIsHoveredAsState().value
+  IconButton(onClick ?: {}, Modifier.requiredSize(20.dp), enabled = onClick != null) {
+    Icon(
+      painterResource(if (onClick == null) MR.images.ic_desktop else if (hovered) MR.images.ic_wifi_off else MR.images.ic_wifi),
+      null,
+      Modifier.size(20.dp).hoverable(interactionSource),
+      tint = if (hovered && onClick != null) WarningOrange else MaterialTheme.colors.onBackground
     )
   }
 }
+
+private fun switchToLocalDevice() {
+  withBGApi {
+    chatController.switchUIRemoteHost(null)
+  }
+}
+
+private fun switchToRemoteHost(h: RemoteHostInfo, switchingUsersAndHosts: MutableState<Boolean>, connecting: MutableState<Boolean>) {
+  if (!h.activeHost()) {
+    withBGApi {
+      val job = launch {
+        delay(500)
+        switchingUsersAndHosts.value = true
+      }
+      ModalManager.closeAllModalsEverywhere()
+      if (h.sessionState != null) {
+        chatModel.controller.switchUIRemoteHost(h.remoteHostId)
+      } else {
+        connectMobileDevice(h, connecting)
+      }
+      job.cancel()
+      switchingUsersAndHosts.value = false
+    }
+  } else {
+    connectMobileDevice(h, connecting)
+  }
+}
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/ModalView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/ModalView.kt
index 0f930b312..703b6f905 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/ModalView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/ModalView.kt
@@ -12,6 +12,7 @@ import chat.simplex.common.model.ChatModel
 import chat.simplex.common.platform.*
 import chat.simplex.common.ui.theme.*
 import java.util.concurrent.atomic.AtomicBoolean
+import kotlin.math.min
 
 @Composable
 fun ModalView(
@@ -86,7 +87,7 @@ class ModalManager(private val placement: ModalPlacement? = null) {
   fun closeModal() {
     if (modalViews.isNotEmpty()) {
       if (modalViews.lastOrNull()?.first == false) modalViews.removeAt(modalViews.lastIndex)
-      else runAtomically { toRemove.add(modalViews.lastIndex - toRemove.size) }
+      else runAtomically { toRemove.add(modalViews.lastIndex - min(toRemove.size, modalViews.lastIndex)) }
     }
     modalCount.value = modalViews.size - toRemove.size
   }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectMobileView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectMobileView.kt
new file mode 100644
index 000000000..d00b9bb67
--- /dev/null
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectMobileView.kt
@@ -0,0 +1,359 @@
+package chat.simplex.common.views.remote
+
+import SectionBottomSpacer
+import SectionDividerSpaced
+import SectionItemView
+import SectionItemViewLongClickable
+import SectionTextFooter
+import SectionView
+import TextIconSpaced
+import androidx.compose.foundation.*
+import androidx.compose.foundation.layout.*
+import androidx.compose.foundation.text.selection.SelectionContainer
+import androidx.compose.material.*
+import androidx.compose.runtime.*
+import androidx.compose.runtime.saveable.rememberSaveable
+import androidx.compose.ui.Modifier
+import androidx.compose.ui.graphics.Color
+import androidx.compose.ui.platform.LocalClipboardManager
+import androidx.compose.ui.text.TextStyle
+import androidx.compose.ui.text.font.*
+import androidx.compose.ui.text.input.*
+import androidx.compose.ui.unit.dp
+import androidx.compose.ui.unit.sp
+import chat.simplex.common.model.*
+import chat.simplex.common.model.ChatController.stopRemoteHostAndReloadHosts
+import chat.simplex.common.model.ChatModel.controller
+import chat.simplex.common.platform.*
+import chat.simplex.common.ui.theme.*
+import chat.simplex.common.views.chat.item.ItemAction
+import chat.simplex.common.views.chatlist.*
+import chat.simplex.common.views.helpers.*
+import chat.simplex.common.views.newchat.QRCode
+import chat.simplex.common.views.usersettings.SettingsActionItemWithContent
+import chat.simplex.res.MR
+import dev.icerock.moko.resources.compose.painterResource
+import dev.icerock.moko.resources.compose.stringResource
+
+@Composable
+fun ConnectMobileView(
+  m: ChatModel
+) {
+  val connecting = rememberSaveable() { mutableStateOf(false) }
+  val remoteHosts = remember { chatModel.remoteHosts }
+  val deviceName = m.controller.appPrefs.deviceNameForRemoteAccess
+  LaunchedEffect(Unit) {
+    controller.reloadRemoteHosts()
+  }
+  ConnectMobileLayout(
+    deviceName = remember { deviceName.state },
+    remoteHosts = remoteHosts,
+    connecting,
+    connectedHost = remember { m.currentRemoteHost },
+    updateDeviceName = {
+      withBGApi {
+        if (it != "") {
+          m.controller.setLocalDeviceName(it)
+          deviceName.set(it)
+        }
+      }
+    },
+    addMobileDevice = { showAddingMobileDevice(connecting) },
+    connectMobileDevice = { connectMobileDevice(it, connecting) },
+    connectDesktop = { withBGApi { chatController.switchUIRemoteHost(null) } },
+    deleteHost = { host ->
+      withBGApi {
+        val success = controller.deleteRemoteHost(host.remoteHostId)
+        if (success) {
+          chatModel.remoteHosts.removeAll { it.remoteHostId == host.remoteHostId }
+        }
+      }
+    }
+  )
+}
+
+@Composable
+fun ConnectMobileLayout(
+  deviceName: State<String?>,
+  remoteHosts: List<RemoteHostInfo>,
+  connecting: MutableState<Boolean>,
+  connectedHost: State<RemoteHostInfo?>,
+  updateDeviceName: (String) -> Unit,
+  addMobileDevice: () -> Unit,
+  connectMobileDevice: (RemoteHostInfo) -> Unit,
+  connectDesktop: () -> Unit,
+  deleteHost: (RemoteHostInfo) -> Unit,
+) {
+  Column(
+    Modifier.fillMaxWidth().verticalScroll(rememberScrollState()),
+    verticalArrangement = Arrangement.spacedBy(8.dp)
+  ) {
+    AppBarTitle(stringResource(if (remember { chatModel.remoteHosts }.isEmpty()) MR.strings.link_a_mobile else MR.strings.linked_mobiles))
+    SectionView(generalGetString(MR.strings.this_device_name).uppercase()) {
+      DeviceNameField(deviceName.value ?: "") { updateDeviceName(it) }
+      SectionTextFooter(generalGetString(MR.strings.this_device_name_shared_with_mobile))
+      SectionDividerSpaced(maxBottomPadding = false)
+    }
+    SectionView(stringResource(MR.strings.devices).uppercase()) {
+      SettingsActionItemWithContent(text = stringResource(MR.strings.this_device), icon = painterResource(MR.images.ic_desktop), click = connectDesktop) {
+        if (connectedHost.value == null) {
+          Icon(painterResource(MR.images.ic_done_filled), null, Modifier.size(20.dp), tint = MaterialTheme.colors.onBackground)
+        }
+      }
+
+      for (host in remoteHosts) {
+        val showMenu = rememberSaveable { mutableStateOf(false) }
+        SectionItemViewLongClickable({ connectMobileDevice(host) }, { showMenu.value = true }, disabled = connecting.value) {
+          Icon(painterResource(MR.images.ic_smartphone_300), host.hostDeviceName, tint = MaterialTheme.colors.secondary)
+          TextIconSpaced(false)
+          Text(host.hostDeviceName)
+          Spacer(Modifier.weight(1f))
+          if (host.activeHost) {
+            Icon(painterResource(MR.images.ic_done_filled), null, Modifier.size(20.dp), tint = MaterialTheme.colors.onBackground)
+          } else if (host.sessionState is RemoteHostSessionState.Connected) {
+            HostDisconnectButton { stopRemoteHostAndReloadHosts(host, false) }
+          }
+        }
+        Box(Modifier.padding(horizontal = DEFAULT_PADDING)) {
+          DefaultDropdownMenu(showMenu) {
+            if (host.activeHost) {
+              ItemAction(stringResource(MR.strings.disconnect_remote_host), painterResource(MR.images.ic_wifi_off), color = WarningOrange) {
+                stopRemoteHostAndReloadHosts(host, true)
+                showMenu.value = false
+              }
+            } else {
+              ItemAction(stringResource(MR.strings.delete_verb), painterResource(MR.images.ic_delete), color = Color.Red) {
+                deleteHost(host)
+                showMenu.value = false
+              }
+            }
+          }
+        }
+      }
+      SectionItemView(addMobileDevice) {
+        Icon(painterResource(MR.images.ic_add), stringResource(MR.strings.link_a_mobile), tint = MaterialTheme.colors.primary)
+        Spacer(Modifier.padding(horizontal = 10.dp))
+        Text(stringResource(MR.strings.link_a_mobile), color = MaterialTheme.colors.primary)
+      }
+    }
+    SectionBottomSpacer()
+  }
+}
+
+@Composable
+private fun DeviceNameField(
+  initialValue: String,
+  onChange: (String) -> Unit
+) {
+  // TODO get user-defined device name
+  val state = remember { mutableStateOf(TextFieldValue(initialValue)) }
+  DefaultConfigurableTextField(
+    state = state,
+    placeholder = generalGetString(MR.strings.enter_this_device_name),
+    modifier = Modifier.padding(start = DEFAULT_PADDING),
+    isValid = { true },
+  )
+  KeyChangeEffect(state.value) {
+    onChange(state.value.text)
+  }
+}
+
+@Composable
+private fun ConnectMobileViewLayout(
+  title: String,
+  invitation: String?,
+  deviceName: String?,
+  sessionCode: String?
+) {
+  Column(
+    Modifier.fillMaxWidth().verticalScroll(rememberScrollState()),
+    verticalArrangement = Arrangement.spacedBy(8.dp)
+  ) {
+    AppBarTitle(title)
+    SectionView {
+      if (invitation != null && sessionCode == null) {
+        QRCode(
+          invitation, Modifier
+            .padding(start = DEFAULT_PADDING, top = DEFAULT_PADDING_HALF, end = DEFAULT_PADDING, bottom = DEFAULT_PADDING_HALF)
+            .aspectRatio(1f)
+        )
+        SectionTextFooter(annotatedStringResource(MR.strings.open_on_mobile_and_scan_qr_code))
+
+        if (remember { controller.appPrefs.developerTools.state }.value) {
+          val clipboard = LocalClipboardManager.current
+          Spacer(Modifier.height(DEFAULT_PADDING_HALF))
+          SectionItemView({ clipboard.shareText(invitation) }) {
+            Text(generalGetString(MR.strings.share_link), color = MaterialTheme.colors.primary)
+          }
+        }
+
+        Spacer(Modifier.height(DEFAULT_PADDING))
+      }
+      if (deviceName != null || sessionCode != null) {
+        SectionView(stringResource(MR.strings.connected_mobile).uppercase()) {
+          SelectionContainer {
+            Text(
+              deviceName ?: stringResource(MR.strings.new_mobile_device),
+              Modifier.padding(start = DEFAULT_PADDING, top = 5.dp, end = DEFAULT_PADDING, bottom = 10.dp),
+              style = TextStyle(fontFamily = FontFamily.Monospace, fontSize = 16.sp, fontStyle = if (deviceName != null) FontStyle.Normal else FontStyle.Italic)
+            )
+          }
+        }
+        Spacer(Modifier.height(DEFAULT_PADDING_HALF))
+      }
+
+      if (sessionCode != null) {
+        SectionView(stringResource(MR.strings.verify_code_on_mobile).uppercase()) {
+          SelectionContainer {
+            Text(
+              sessionCode.substring(0, 23),
+              Modifier.padding(start = DEFAULT_PADDING, top = 5.dp, end = DEFAULT_PADDING, bottom = 10.dp),
+              style = TextStyle(fontFamily = FontFamily.Monospace, fontSize = 16.sp)
+            )
+          }
+        }
+      }
+    }
+  }
+}
+
+fun connectMobileDevice(rh: RemoteHostInfo, connecting: MutableState<Boolean>) {
+  if (!rh.activeHost() && rh.sessionState is RemoteHostSessionState.Connected) {
+    withBGApi {
+      controller.switchUIRemoteHost(rh.remoteHostId)
+    }
+  } else if (rh.activeHost()) {
+    showConnectedMobileDevice(rh) {
+      stopRemoteHostAndReloadHosts(rh, true)
+    }
+  } else {
+    showConnectMobileDevice(rh, connecting)
+  }
+}
+
+private fun showAddingMobileDevice(connecting: MutableState<Boolean>) {
+  ModalManager.start.showModalCloseable { close ->
+    val invitation = rememberSaveable { mutableStateOf<String?>(null) }
+    val pairing = remember { chatModel.newRemoteHostPairing }
+    val sessionCode = when (val state = pairing.value?.second) {
+      is RemoteHostSessionState.PendingConfirmation -> state.sessionCode
+      else -> null
+    }
+    /** It's needed to prevent screen flashes when [chatModel.newRemoteHostPairing] sets to null in background */
+    var cachedSessionCode by remember { mutableStateOf<String?>(null) }
+    if (cachedSessionCode == null && sessionCode != null) {
+      cachedSessionCode = sessionCode
+    }
+    val remoteDeviceName = pairing.value?.first?.hostDeviceName
+    ConnectMobileViewLayout(
+      title = if (cachedSessionCode == null) stringResource(MR.strings.link_a_mobile) else stringResource(MR.strings.verify_connection),
+      invitation = invitation.value,
+      deviceName = remoteDeviceName,
+      sessionCode = cachedSessionCode
+    )
+    val oldRemoteHostId by remember { mutableStateOf(chatModel.currentRemoteHost.value?.remoteHostId) }
+    LaunchedEffect(remember { chatModel.currentRemoteHost }.value) {
+      if (chatModel.currentRemoteHost.value?.remoteHostId != null && chatModel.currentRemoteHost.value?.remoteHostId != oldRemoteHostId) {
+        close()
+      }
+    }
+    KeyChangeEffect(pairing.value) {
+      if (pairing.value == null) {
+        close()
+      }
+    }
+    DisposableEffect(Unit) {
+      withBGApi {
+        val r = chatModel.controller.startRemoteHost(null)
+        if (r != null) {
+          connecting.value = true
+          invitation.value = r.second
+        }
+      }
+      onDispose {
+        if (chatModel.currentRemoteHost.value?.remoteHostId == oldRemoteHostId) {
+          withBGApi {
+            chatController.stopRemoteHost(null)
+          }
+        }
+        chatModel.newRemoteHostPairing.value = null
+      }
+    }
+  }
+}
+
+private fun showConnectMobileDevice(rh: RemoteHostInfo, connecting: MutableState<Boolean>) {
+  ModalManager.start.showModalCloseable { close ->
+    val pairing = remember { chatModel.newRemoteHostPairing }
+    val invitation = rememberSaveable { mutableStateOf<String?>(null) }
+    val sessionCode = when (val state = pairing.value?.second) {
+      is RemoteHostSessionState.PendingConfirmation -> state.sessionCode
+      else -> null
+    }
+    /** It's needed to prevent screen flashes when [chatModel.newRemoteHostPairing] sets to null in background */
+    var cachedSessionCode by remember { mutableStateOf<String?>(null) }
+    if (cachedSessionCode == null && sessionCode != null) {
+      cachedSessionCode = sessionCode
+    }
+    ConnectMobileViewLayout(
+      title = if (cachedSessionCode == null) stringResource(MR.strings.scan_from_mobile) else stringResource(MR.strings.verify_connection),
+      invitation = invitation.value,
+      deviceName = pairing.value?.first?.hostDeviceName ?: rh.hostDeviceName,
+      sessionCode = cachedSessionCode,
+    )
+    var remoteHostId by rememberSaveable { mutableStateOf<Long?>(null) }
+    LaunchedEffect(Unit) {
+      val r = chatModel.controller.startRemoteHost(rh.remoteHostId)
+      if (r != null) {
+        val (rh_, inv) = r
+        connecting.value = true
+        remoteHostId = rh_?.remoteHostId
+        invitation.value = inv
+      }
+    }
+    LaunchedEffect(remember { chatModel.currentRemoteHost }.value) {
+      if (remoteHostId != null && chatModel.currentRemoteHost.value?.remoteHostId == remoteHostId) {
+        close()
+      }
+    }
+    KeyChangeEffect(pairing.value) {
+      if (pairing.value == null) {
+        close()
+      }
+    }
+    DisposableEffect(Unit) {
+      onDispose {
+        if (remoteHostId != null && chatModel.currentRemoteHost.value?.remoteHostId != remoteHostId) {
+          withBGApi {
+            chatController.stopRemoteHost(remoteHostId)
+          }
+        }
+        chatModel.newRemoteHostPairing.value = null
+      }
+    }
+  }
+}
+
+private fun showConnectedMobileDevice(rh: RemoteHostInfo, disconnectHost: () -> Unit) {
+  ModalManager.start.showModalCloseable { close ->
+    val sessionCode = when (val state = rh.sessionState) {
+      is RemoteHostSessionState.Connected -> state.sessionCode
+      else -> null
+    }
+    Column {
+      ConnectMobileViewLayout(
+        title = stringResource(MR.strings.connected_to_mobile),
+        invitation = null,
+        deviceName = rh.hostDeviceName,
+        sessionCode = sessionCode
+      )
+      Spacer(Modifier.height(DEFAULT_PADDING_HALF))
+      SectionItemView(disconnectHost) {
+        Text(generalGetString(MR.strings.disconnect_remote_host), Modifier.fillMaxWidth(), color = WarningOrange)
+      }
+    }
+    KeyChangeEffect(remember { chatModel.currentRemoteHost }.value) {
+      close()
+    }
+  }
+}
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt
index d949f800b..5fa3c4147 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt
@@ -29,6 +29,7 @@ import chat.simplex.common.views.database.DatabaseView
 import chat.simplex.common.views.helpers.*
 import chat.simplex.common.views.onboarding.SimpleXInfo
 import chat.simplex.common.views.onboarding.WhatsNewView
+import chat.simplex.common.views.remote.ConnectMobileView
 import chat.simplex.res.MR
 import kotlinx.coroutines.launch
 
@@ -155,6 +156,9 @@ fun SettingsLayout(
         SettingsActionItem(painterResource(MR.images.ic_manage_accounts), stringResource(MR.strings.your_chat_profiles), { withAuth(generalGetString(MR.strings.auth_open_chat_profiles), generalGetString(MR.strings.auth_log_in_using_credential)) { showSettingsModalWithSearch { it, search -> UserProfilesView(it, search, profileHidden) } } }, disabled = stopped, extraPadding = true)
         SettingsActionItem(painterResource(MR.images.ic_qr_code), stringResource(MR.strings.your_simplex_contact_address), showCustomModal { it, close -> UserAddressView(it, shareViaProfile = it.currentUser.value!!.addressShared, close = close) }, disabled = stopped, extraPadding = true)
         ChatPreferencesItem(showCustomModal, stopped = stopped)
+        if (appPlatform.isDesktop) {
+          SettingsActionItem(painterResource(MR.images.ic_smartphone), stringResource(if (remember { chatModel.remoteHosts }.isEmpty()) MR.strings.link_a_mobile else MR.strings.linked_mobiles), showModal { ConnectMobileView(it) }, disabled = stopped, extraPadding = true)
+        }
       }
       SectionDividerSpaced()
 
diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml
index 170a28f3d..9889d6ab7 100644
--- a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml
+++ b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml
@@ -1625,6 +1625,24 @@
   <string name="you_can_enable_delivery_receipts_later_alert">You can enable them later via app Privacy &amp; Security settings.</string>
   <string name="error_enabling_delivery_receipts">Error enabling delivery receipts!</string>
 
+  <!-- Remote access -->
+  <string name="link_a_mobile">Link a mobile</string>
+  <string name="linked_mobiles">Linked mobiles</string>
+  <string name="scan_from_mobile">Scan from mobile</string>
+  <string name="verify_connection">Verify connection</string>
+  <string name="verify_code_on_mobile">Verify code on mobile</string>
+  <string name="this_device_name">This device name</string>
+  <string name="connected_mobile">Connected mobile</string>
+  <string name="connected_to_mobile">Connected to mobile</string>
+  <string name="enter_this_device_name">Enter this device name…</string>
+  <string name="this_device_name_shared_with_mobile">The device name will be shared with the connected mobile client.</string>
+  <string name="error">Error</string>
+  <string name="this_device">This device</string>
+  <string name="devices">Devices</string>
+  <string name="new_mobile_device">New mobile device</string>
+  <string name="disconnect_remote_host">Disconnect</string>
+  <string name="open_on_mobile_and_scan_qr_code"><![CDATA[Open <i>Use from desktop</i> in mobile app and scan QR code]]></string>
+
   <!-- Under development -->
   <string name="in_developing_title">Coming soon!</string>
   <string name="in_developing_desc">This feature is not yet supported. Try the next release.</string>
diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_smartphone.svg b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_smartphone.svg
new file mode 100644
index 000000000..93094d144
--- /dev/null
+++ b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_smartphone.svg
@@ -0,0 +1 @@
+<svg xmlns="http://www.w3.org/2000/svg" height="24" viewBox="0 -960 960 960" width="24"><path d="M261.5-45q-22.969 0-40.234-17.266Q204-79.53 204-102.5v-755q0-22.969 17.266-40.234Q238.531-915 261.5-915h437q22.969 0 40.234 17.266Q756-880.469 756-857.5v755q0 22.969-17.266 40.234Q721.469-45 698.5-45h-437Zm0-88.5v31h437v-31h-437Zm0-57.5h437v-578h-437v578Zm0-635.5h437v-31h-437v31Zm0 0v-31 31Zm0 693v31-31Z"/></svg>
\ No newline at end of file
diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_smartphone_300.svg b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_smartphone_300.svg
new file mode 100644
index 000000000..7d8553db1
--- /dev/null
+++ b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_smartphone_300.svg
@@ -0,0 +1 @@
+<svg xmlns="http://www.w3.org/2000/svg" height="24" viewBox="0 -960 960 960" width="24"><path d="M278.533-63.078q-22.606 0-39.338-16.732t-16.732-39.327v-721.726q0-22.595 16.732-39.327t39.338-16.732h402.934q22.606 0 39.338 16.732t16.732 39.327v721.726q0 22.595-16.732 39.327t-39.338 16.732H278.533Zm-12.225-87.154v31q0 4.616 3.846 8.462 3.847 3.847 8.463 3.847h402.766q4.616 0 8.463-3.847 3.846-3.846 3.846-8.462v-31H266.308Zm0-43.845h427.384v-571.846H266.308v571.846Zm0-615.691h427.384v-31q0-4.616-3.846-8.462-3.847-3.847-8.463-3.847H278.617q-4.616 0-8.463 3.847-3.846 3.846-3.846 8.462v31Zm0 0V-853.077v43.309Zm0 659.536V-106.923v-43.309Z"/></svg>
\ No newline at end of file
diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_wifi.svg b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_wifi.svg
new file mode 100644
index 000000000..2fb4750af
--- /dev/null
+++ b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_wifi.svg
@@ -0,0 +1 @@
+<svg xmlns="http://www.w3.org/2000/svg" height="24" viewBox="0 -960 960 960" width="24"><path d="M479.965-133.5q-34.965 0-61.215-26.295-26.25-26.296-26.25-61.275 0-34.43 26.285-60.93t61.25-26.5q34.965 0 61.215 26.57 26.25 26.571 26.25 61.25 0 34.68-26.285 60.93t-61.25 26.25ZM234-361l-60.5-59.5Q243-490 318-524.5T480-559q87 0 162.026 34.538Q717.053-489.923 786.5-421l-60 60q-61-60.5-122.532-86.25-61.533-25.75-124-25.75Q417.5-473 356-447.25T234-361ZM70.5-524.5l-60.5-60q91-93 211.947-150t258-57Q617-791.5 738-734.5t212 150l-60 60Q802.5-607 700.1-656.25t-220-49.25q-117.6 0-220.1 49.25T70.5-524.5Z"/></svg>
\ No newline at end of file
diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_wifi_off.svg b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_wifi_off.svg
new file mode 100644
index 000000000..814077e48
--- /dev/null
+++ b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_wifi_off.svg
@@ -0,0 +1 @@
+<svg xmlns="http://www.w3.org/2000/svg" height="24" viewBox="0 -960 960 960" width="24"><path d="m803.5-74-392-391.5Q357-453 312.25-424T234-361l-60.5-59.5q37-37 75.75-64.75T343.5-535l-108-108q-47 23-88.5 54t-76.5 64.5L10-584q36-37 76.5-68.75T170-707.5L76-802l41-41 727.5 727.5-41 41.5ZM480-133.5q-35 0-61.25-26T392.5-221q0-34.5 26.25-61T480-308.5q35 0 61.25 26.5t26.25 61q0 35.5-26.25 61.5t-61.25 26Zm245.5-226Q693-391 666-410.5t-68.5-38l-110-110q93 2 164.25 38.75T786.5-420.5l-61 61Zm164.5-165q-87.5-83-190.25-132T480-705.5q-37 0-69.5 4.5t-54 12l-70-70q42.5-15 91.75-23.75T480-791.5q137 0 257.5 56.75T950-584l-60 59.5Z"/></svg>
\ No newline at end of file
diff --git a/flake.nix b/flake.nix
index 3ef1913fd..14b7ae731 100644
--- a/flake.nix
+++ b/flake.nix
@@ -337,6 +337,7 @@
                   "chat_recv_msg"
                   "chat_recv_msg_wait"
                   "chat_send_cmd"
+                  "chat_send_remote_cmd"
                   "chat_valid_name"
                   "chat_write_file"
                 ];
@@ -435,6 +436,7 @@
                   "chat_recv_msg"
                   "chat_recv_msg_wait"
                   "chat_send_cmd"
+                  "chat_send_remote_cmd"
                   "chat_valid_name"
                   "chat_write_file"
                 ];
diff --git a/libsimplex.dll.def b/libsimplex.dll.def
index 755119fca..2d6e813d7 100644
--- a/libsimplex.dll.def
+++ b/libsimplex.dll.def
@@ -3,6 +3,7 @@ EXPORTS
     hs_init
     chat_migrate_init
     chat_send_cmd
+    chat_send_remote_cmd
     chat_recv_msg
     chat_recv_msg_wait
     chat_parse_markdown

From d0f3a3d886df605ae102d29a42c67e0c99b39c92 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 16 Nov 2023 21:53:54 +0000
Subject: [PATCH 51/69] rfc: remote UI implementation (#3206)

---
 docs/rfcs/2023-09-12-remote-profile.md | 25 ++++++--
 docs/rfcs/2023-10-12-remote-ui.md      | 88 ++++++++++++++++++++++++++
 2 files changed, 107 insertions(+), 6 deletions(-)
 create mode 100644 docs/rfcs/2023-10-12-remote-ui.md

diff --git a/docs/rfcs/2023-09-12-remote-profile.md b/docs/rfcs/2023-09-12-remote-profile.md
index 9a41d55d5..a36c1bfcf 100644
--- a/docs/rfcs/2023-09-12-remote-profile.md
+++ b/docs/rfcs/2023-09-12-remote-profile.md
@@ -125,9 +125,10 @@ Alternatively a mobile (or a desktop, why not) may signal that they're done here
 At any time a user may click on a "cancel" button and return to the main UI.
 That should fully re-initialise UI state.
 
-In the "Network & servers" section of "Settings", there is an item to list all the registered remote controllers with buttons attached to *dispose* them one by one.
-*Disposing* a remote controller means its entry will be removed from database.
-Future connection attempts from a disposed device would be treated exactly as from a previously-unknown device.
+This screen should have a way to open the list of all known remote controllers (desktop devices), to allow removing them.
+
+*Removing* remote controller means its entry will be removed from database.
+Future connection attempts with a removed desktop will be treated as with a previously unknown device.
 
 ### On a desktop device
 
@@ -148,8 +149,9 @@ Future connection attempts from a disposed device would be treated exactly as fr
 4. A user may open sidebar and click "disconnect from mobile" to close the session and return to local mode.
   * That should fully re-initialise UI state.
 
-In the "Network & servers" section of "Settings", there is an item to list all the registered remote hosts with buttons attached to *dispose* them one by one.
-*Disposing* a remote host means its entry will be removed from database and any associated files deleted (photos, voice messages, transferred files etc).
+Unlike mobile UI, removing known mobiles should happen via the same screen that shows connected mobile deivices.
+
+*Removing* a remote host means its entry will be removed from database and any associated files deleted (photos, voice messages, transferred files etc).
 
 ## Caveats
 
@@ -192,9 +194,20 @@ A backup system may be implemented by attaching a headless app to a bouncer as o
 The unauthenticated remote host can be considered a feature.
 A use case for that may be something like a "dead drop" host that wakes up in response to any discovery broadcast.
 
-## Unresolved questions
+## Other questions
 
 - What to do with WebRTC/calls?
+
+Calls use local desktop implementation, they will use host for signalling.
+
 - Do we want attaching only to a subset of profiles?
+
+No.
+
 - Do we want a client to mix remote and local profiles?
+
+No.
+
 - Do we want M-to-N sessions? (follows naturally from the previous two)
+
+No.
diff --git a/docs/rfcs/2023-10-12-remote-ui.md b/docs/rfcs/2023-10-12-remote-ui.md
new file mode 100644
index 000000000..308babf5c
--- /dev/null
+++ b/docs/rfcs/2023-10-12-remote-ui.md
@@ -0,0 +1,88 @@
+# Remote desktop / mobile implementation details
+
+This follows the previous RFC for [remote profiles](./2023-09-12-remote-profile.md).
+
+Code uses terms remote controller and remote host to designate the roles, and CLI client can support both.
+
+This document uses the terms "mobile" to mean remote host and "desktop" to mean remote controller, mobile apps will only support "remote host" role (via UI, and, possibly, via the compilation flag to remove this functionality from the code), and desktop will only support "remote controller" role.
+
+## Mobile (host)
+
+UX is described [here](./2023-09-12-remote-profile.md#on-a-mobile-device).
+
+When mobile is connected to the remote desktop it will receive no events from the core (other than remote session connection status changes), and the core will accept no commands from the UI (other than to terminate the remote session).
+
+As currently mobile maintains the list of connection statuses for all profiles, this state will have to be maintained in Haskell to be able to send it to the remote desktop UI when it is connected. It will also be used to update mobile UI when control is returned to the mobile.
+
+The switching between remote host role and local UI role should prevent the possibility of any race conditions.
+
+To swith to remote host role:
+- UI: will show the screen with "connected" status and "cancel" button, with disabled sleep timer on iOS, as iOS app will have to stay in foregro. Android will be able to function in background in this state.
+- core: stop adding events to the output queues (via some flag).
+- UI: process remaining events in the output queue and stop receiving them.
+- core: stop sending events to and accepting commands from UI.
+- core: send current list of profiles, coversations, and connections statuses to the remote desktop.
+- core: start sending events to and accepting commands from remote desktop.
+- core: start adding events to remote output queue.
+
+To switch back to local UI role:
+- core: stop adding events to the output queues.
+- core: stop receiving commands from and sending events to remote desktop.
+- remote desktop: receive pending events and stop processing them.
+- UI: load current list of profiles, conversations, and connection statuses from the core.
+- UI: start receiving events
+- core: start sending events to and accepting commands from local UI.
+- core: start adding events to UI local remote output queue.
+
+Possibly, there is a simpler way to switch, but it is important that the new events are applied to the loaded state, to avoid state being out of sync.
+
+## Desktop (controller)
+
+Desktop can either control local profiles ("local host" term is used) or remote host(s)/mobile(s). Only one host, local or remote, can be controlled at a time. It is important though to be able to receive notifications from multiple hosts, at the very least from local and mobile, as the important use case is this:
+
+- mobile device only has contacts and important groups to save the traffic and battery.
+- desktop has large public groups.
+
+So while reading large public groups the users should be able to receive notifications from both mobile device and local profile(s).
+
+That means that while only one host can be active in desktop, multiple hosts can be connected.
+
+Current UI model contains:
+- the list of the conversations for the chosen profile.
+- the list of the user profiles.
+- the statuses of connections across all profiles - this is maintained because the core does not track connection statuses.
+
+As the core will start maintaining the connection statuses, as a possible optimisation we could reduce the connections in the UI to only the current profile and reset it every time the profile is switched.
+
+In addition to the above, the UI model will need to contain the list of connected remote hosts (mobiles), so that the user can switch between them.
+
+Switching profile currently updates the list of conversations. If connection statuses are narrowed to the current profile only, they will have to be updated as well.
+
+When switching host (whether to local or to remote), the UI will have to:
+- update the list of profiles
+- update the list of conversations for the active profile in the host
+- update connection statuses, either for all profiles or for the active profile only - TBC
+
+When connected to remote host, or possibly always, UI will have to use the extended FFI to indicate the host in all commands (e.g., to allow automatic file reception in inactive hosts) - as the core cannot simply assume which host is active. Probably, some of the commands (most of them) should require the host to match the currently active host in the core, file reception will not require that.
+
+### Onboarding and "only-remote" desktop
+
+Majority of the users want to use desktop in "remote-only" role, when there is no local profile. Currently, it is a global assumption that the core has an active profile for most commands. Possible solutions to that are:
+
+- update core to allow functioning without local profile.
+- create an invisible phantom profile that won't be shown in the UI but will be used by the core to process commands related to remote hosts (connected mobiles).
+
+The 2nd option seems simpler. The phantom profile will use an empty string as display name, and, possibly an additional flag to mark it as phantom. Once a real profile is created this phatom one can be removed (or can be just abandoned). It might be better to block most commands for this phantom profile?
+
+Onboarding on desktop will need to be re-implemented to offer connecting to mobile as primary option and creating a local profile as secondary, and from the users' point of view they will not be creating any local profiles.
+
+## Loading files
+
+Currently active UI, either remote (desktop) or local (mobile), will be making the decision to auto-receive file, based on its own local settings. It seems a better trade-off than alternatives, and also allows for different auto-receive configurations based on the device.
+
+Forwarding received and uploading sent files to/from desktop is already implemented.
+
+It is still required to implement both commands API in FFI layer and, possibly, HTTP API to download files to desktop when they are:
+- shown in the UI for images.
+- played for voice and video messages.
+- saved for any other files.

From cf102da4d35cda4516ad42e5ca37482031647446 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Fri, 17 Nov 2023 13:19:33 +0200
Subject: [PATCH 52/69] remote:  add test for rejected ca detection and
 stability  (#3382)

* add test for rejected ca detection and stability

* update mq commit
---
 cabal.project             |  2 +-
 scripts/nix/sha256map.nix |  2 +-
 stack.yaml                |  2 +-
 tests/RemoteTests.hs      | 31 +++++++++++++++++++++++++++++++
 4 files changed, 34 insertions(+), 3 deletions(-)

diff --git a/cabal.project b/cabal.project
index b7baee588..642f3d102 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: 3b348a463cd83fbd803743b1d67f282a42d8b654
+    tag: c501f4f9ccdd48807a5153697ea1827129841158
 
 source-repository-package
     type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 5f6574288..c211fc99e 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."3b348a463cd83fbd803743b1d67f282a42d8b654" = "1rbd5zz1rclnfvjf68ll5qhi9yqk040bi491z10hwyhxi2bixpaw";
+  "https://github.com/simplex-chat/simplexmq.git"."c501f4f9ccdd48807a5153697ea1827129841158" = "1s99mjc7rjk9wg14m5xddw64a3mlr8l7ba9mclma598hg73l0vaw";
   "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/stack.yaml b/stack.yaml
index 4ef1c422e..f3d98d7f6 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: 3b348a463cd83fbd803743b1d67f282a42d8b654
+    commit: c501f4f9ccdd48807a5153697ea1827129841158
   - github: kazu-yamamoto/http2
     commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
   # - ../direct-sqlcipher
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index 0d3dc7462..db19cac51 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 "refuses invalid client cert" remoteHandshakeRejectTest
   it "sends messages" remoteMessageTest
   describe "remote files" $ do
     it "store/get/send/receive files" remoteStoreFileTest
@@ -95,6 +96,36 @@ remoteHandshakeStoredTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile
   startRemoteStored 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"
+  startRemote mobile desktop
+  stopMobile mobile desktop
+
+  mobileBob ##> "/set device name MobileBob"
+  mobileBob <## "ok"
+  desktop ##> "/start remote host 1"
+  desktop <## "remote host 1 started"
+  desktop <## "Remote session invitation:"
+  inv <- getTermLine desktop
+  mobileBob ##> ("/connect remote ctrl " <> inv)
+  mobileBob <## "connecting new remote controller: My desktop, v5.4.0.3"
+  mobileBob <## "remote controller stopped"
+
+  -- the server remains active after rejecting invalid client
+  mobile ##> ("/connect remote ctrl " <> inv)
+  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
+  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"
+  stopMobile mobile desktop
+
 remoteMessageTest :: HasCallStack => FilePath -> IO ()
 remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
   startRemote mobile desktop

From f6c4e969e4d2ae6a59c50b93ed666bf1e4e4660c Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Fri, 17 Nov 2023 13:28:10 +0000
Subject: [PATCH 53/69] nix: add openssl to simplexmq, swift flag to
 simplex-chat (#3386)

* nix: add swift flag

* add openssl for simplexmq to nix

* add openssl to android simplemq, try iOS with enableKTLS = false flag

* fix android
---
 flake.nix | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

diff --git a/flake.nix b/flake.nix
index e14e57ca7..4466fa110 100644
--- a/flake.nix
+++ b/flake.nix
@@ -154,6 +154,9 @@
                   packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [
                     (pkgs.pkgsCross.mingwW64.openssl) #.override) # { static = true; enableKTLS = false; })
                   ];
+                  packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
+                    (pkgs.pkgsCross.mingwW64.openssl) #.override) # { static = true; enableKTLS = false; })
+                  ];
                   packages.unix-time.postPatch = ''
                     sed -i 's/mingwex//g' unix-time.cabal
                   '';
@@ -185,6 +188,9 @@
                   packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [
                     pkgs.pkgsCross.mingwW64.openssl
                   ];
+                  packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
+                    pkgs.pkgsCross.mingwW64.openssl
+                  ];
                   packages.unix-time.postPatch = ''
                     sed -i 's/mingwex//g' unix-time.cabal
                   '';
@@ -309,6 +315,9 @@
                   packages.direct-sqlcipher.patches = [
                     ./scripts/nix/direct-sqlcipher-android-log.patch
                   ];
+                  packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
+                    (android32Pkgs.openssl.override { static = true; enableKTLS = false; })
+                  ];
                   # 32 bit patches
                   packages.basement.patches = [
                     ./scripts/nix/basement-pr-573.patch
@@ -413,6 +422,9 @@
                   packages.direct-sqlcipher.patches = [
                     ./scripts/nix/direct-sqlcipher-android-log.patch
                   ];
+                  packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
+                    (androidPkgs.openssl.override { static = true; })
+                  ];
                 }];
               }).simplex-chat.components.library.override (p: {
                 smallAddressSpace = true;
@@ -509,9 +521,13 @@
               "aarch64-darwin-ios:lib:simplex-chat" = (drv' {
                 pkgs' = pkgs;
                 extra-modules = [{
+                  packages.simplex-chat.flags.swift = true;
                   packages.simplexmq.flags.swift = true;
                   packages.direct-sqlcipher.flags.commoncrypto = true;
                   packages.entropy.flags.DoNotGetEntropy = true;
+                  packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
+                    (pkgs.openssl.override { static = true; })
+                  ];
                 }];
               }).simplex-chat.components.library.override (
                 iosOverrides "pkg-ios-aarch64-swift-json"
@@ -522,6 +538,9 @@
                 extra-modules = [{
                   packages.direct-sqlcipher.flags.commoncrypto = true;
                   packages.entropy.flags.DoNotGetEntropy = true;
+                  packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
+                    (pkgs.openssl.override { static = true; })
+                  ];
                 }];
               }).simplex-chat.components.library.override (
                 iosOverrides "pkg-ios-aarch64-tagged-json"
@@ -532,9 +551,13 @@
               "x86_64-darwin-ios:lib:simplex-chat" = (drv' {
                 pkgs' = pkgs;
                 extra-modules = [{
+                  packages.simplex-chat.flags.swift = true;
                   packages.simplexmq.flags.swift = true;
                   packages.direct-sqlcipher.flags.commoncrypto = true;
                   packages.entropy.flags.DoNotGetEntropy = true;
+                  packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
+                    (pkgs.openssl.override { static = true; })
+                  ];
                 }];
               }).simplex-chat.components.library.override (
                 iosOverrides "pkg-ios-x86_64-swift-json"
@@ -545,6 +568,9 @@
                 extra-modules = [{
                   packages.direct-sqlcipher.flags.commoncrypto = true;
                   packages.entropy.flags.DoNotGetEntropy = true;
+                  packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
+                    (pkgs.openssl.override { static = true; })
+                  ];
                 }];
               }).simplex-chat.components.library.override (
                 iosOverrides "pkg-ios-x86_64-tagged-json"

From 84e09f195c710d366d29d8ecb13930b37b5b7ecf Mon Sep 17 00:00:00 2001
From: Stanislav Dmitrenko <7953703+avently@users.noreply.github.com>
Date: Sat, 18 Nov 2023 02:19:02 +0800
Subject: [PATCH 54/69] desktop (windows): fix build of CLI (#3387)

---
 .github/workflows/build.yml                |  9 +++++++++
 scripts/desktop/build-lib-windows.sh       | 13 +++----------
 scripts/desktop/prepare-openssl-windows.sh | 21 +++++++++++++++++++++
 3 files changed, 33 insertions(+), 10 deletions(-)
 create mode 100644 scripts/desktop/prepare-openssl-windows.sh

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 6687f4797..592e03257 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -266,6 +266,15 @@ jobs:
         if: matrix.os == 'windows-latest'
         shell: bash
         run: |
+          scripts/desktop/prepare-openssl-windows.sh
+          openssl_windows_style_path=$(echo `pwd`/dist-newstyle/openssl-1.1.1w | sed 's#/\([a-zA-Z]\)#\1:#' | sed 's#/#\\#g')
+          rm cabal.project.local 2>/dev/null || true
+          echo "ignore-project: False" >> cabal.project.local
+          echo "package direct-sqlcipher" >> cabal.project.local
+          echo "    flags: +openssl" >> cabal.project.local
+          echo "    extra-include-dirs: $openssl_windows_style_path\include" >> cabal.project.local
+          echo "    extra-lib-dirs: $openssl_windows_style_path" >> cabal.project.local
+
           rm -rf dist-newstyle/src/direct-sq*
           sed -i "s/, unix /--, unix /" simplex-chat.cabal
           cabal build --enable-tests
diff --git a/scripts/desktop/build-lib-windows.sh b/scripts/desktop/build-lib-windows.sh
index 881e0aea2..bd2cdc1c2 100755
--- a/scripts/desktop/build-lib-windows.sh
+++ b/scripts/desktop/build-lib-windows.sh
@@ -30,16 +30,9 @@ BUILD_DIR=dist-newstyle/build/$ARCH-$OS/ghc-*/simplex-chat-*
 cd $root_dir
 mkdir dist-newstyle 2>/dev/null || true
 
-if [ ! -f dist-newstyle/openssl-1.1.1w/libcrypto-1_1-x64.dll ]; then
-	cd dist-newstyle
-    curl https://www.openssl.org/source/openssl-1.1.1w.tar.gz -o openssl.tar.gz
-    $WINDIR\\System32\\tar.exe -xvzf openssl.tar.gz
-	cd openssl-1.1.1w
-	./Configure mingw64
-	make
-	cd ../../
-fi
-openssl_windows_style_path=$(echo `pwd`/dist-newstyle/openssl-1.1.1w | sed 's#/\([a-z]\)#\1:#' | sed 's#/#\\#g')
+scripts/desktop/prepare-openssl-windows.sh
+
+openssl_windows_style_path=$(echo `pwd`/dist-newstyle/openssl-1.1.1w | sed 's#/\([a-zA-Z]\)#\1:#' | sed 's#/#\\#g')
 rm -rf $BUILD_DIR 2>/dev/null || true
 # Existence of this directory produces build error: cabal's bug
 rm -rf dist-newstyle/src/direct-sq* 2>/dev/null || true
diff --git a/scripts/desktop/prepare-openssl-windows.sh b/scripts/desktop/prepare-openssl-windows.sh
new file mode 100644
index 000000000..79822d3ff
--- /dev/null
+++ b/scripts/desktop/prepare-openssl-windows.sh
@@ -0,0 +1,21 @@
+#!/bin/bash
+
+set -e
+
+function readlink() {
+  echo "$(cd "$(dirname "$1")"; pwd -P)"
+}
+root_dir="$(dirname "$(dirname "$(readlink "$0")")")"
+
+cd $root_dir
+
+if [ ! -f dist-newstyle/openssl-1.1.1w/libcrypto-1_1-x64.dll ]; then
+    mkdir dist-newstyle 2>/dev/null || true
+    cd dist-newstyle
+    curl https://www.openssl.org/source/openssl-1.1.1w.tar.gz -o openssl.tar.gz
+    $WINDIR\\System32\\tar.exe -xvzf openssl.tar.gz
+    cd openssl-1.1.1w
+    ./Configure mingw64
+    make
+    cd ../../
+fi

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 55/69] 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 642f3d102..458323797 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 c211fc99e..0ccb77a74 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 e2439f69d..feda221a0 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 68d909f78..2ff9b078c 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 331e3348a..f1ff0cada 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 a6843de60..3060723a1 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 f3d98d7f6..fd831e810 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 db19cac51..dc2f890a7 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

From c9a1de6e4b20f3aa0898942b0f32c4d0acdbf8d7 Mon Sep 17 00:00:00 2001
From: Stanislav Dmitrenko <7953703+avently@users.noreply.github.com>
Date: Sat, 18 Nov 2023 03:20:44 +0800
Subject: [PATCH 56/69] msys2 setup in different place (#3389)

---
 .github/workflows/build.yml | 32 +++++++++++++++++---------------
 1 file changed, 17 insertions(+), 15 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 592e03257..600b934bd 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -261,11 +261,27 @@ jobs:
       # / Windows
       # rm -rf dist-newstyle/src/direct-sq* is here because of the bug in cabal's dependency which prevents second build from finishing
 
+      - name: 'Setup MSYS2'
+        if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'windows-latest'
+        uses: msys2/setup-msys2@v2
+        with:
+          msystem: ucrt64
+          update: true
+          install: >-
+            git
+            perl
+            make
+          pacboy: >-
+            toolchain:p
+            cmake:p
+
+
       - name: Windows build
         id: windows_build
         if: matrix.os == 'windows-latest'
-        shell: bash
+        shell: msys2 {0}
         run: |
+          export PATH=$PATH:/c/ghcup/bin
           scripts/desktop/prepare-openssl-windows.sh
           openssl_windows_style_path=$(echo `pwd`/dist-newstyle/openssl-1.1.1w | sed 's#/\([a-zA-Z]\)#\1:#' | sed 's#/#\\#g')
           rm cabal.project.local 2>/dev/null || true
@@ -302,20 +318,6 @@ jobs:
           body: |
             ${{ steps.windows_build.outputs.bin_hash }}
 
-      - name: 'Setup MSYS2'
-        if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'windows-latest'
-        uses: msys2/setup-msys2@v2
-        with:
-          msystem: ucrt64
-          update: true
-          install: >-
-            git
-            perl
-            make
-          pacboy: >-
-            toolchain:p
-            cmake:p
-
       - name: Windows build desktop
         id: windows_desktop_build
         if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'windows-latest'

From 80abc18371feac57a68a8778390008019ce3ca16 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 18 Nov 2023 15:35:06 +0000
Subject: [PATCH 57/69] core: update simplexmq (xrcp)

---
 cabal.project             | 2 +-
 scripts/nix/sha256map.nix | 2 +-
 stack.yaml                | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/cabal.project b/cabal.project
index 458323797..4652ee311 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: 40ba94ce72fb4273641c56fd4c60cd133a24925a
+    tag: 08410671323c056bbcf1a3f2756aad810b522e25
 
 source-repository-package
     type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 0ccb77a74..de10eb829 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."40ba94ce72fb4273641c56fd4c60cd133a24925a" = "0vqjk4c5vd32y92myv6xr4jhipqza6n08qpii4a0xw6ssm5dgc88";
+  "https://github.com/simplex-chat/simplexmq.git"."08410671323c056bbcf1a3f2756aad810b522e25" = "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/stack.yaml b/stack.yaml
index fd831e810..3006b8a61 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: 40ba94ce72fb4273641c56fd4c60cd133a24925a
+    commit: 08410671323c056bbcf1a3f2756aad810b522e25
   - github: kazu-yamamoto/http2
     commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
   # - ../direct-sqlcipher

From e95d9d0b49cdbb66440bba62ad55eba5938fad22 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 18 Nov 2023 19:18:02 +0000
Subject: [PATCH 58/69] core: rename migration to remote-control, comments
 (#3393)

---
 simplex-chat.cabal                            |  2 +-
 .../Migrations/M20231114_remote_control.hs    | 45 ++++++++++++++++++
 .../Migrations/M20231114_remote_controller.hs | 47 -------------------
 src/Simplex/Chat/Migrations/chat_schema.sql   | 38 +++++++--------
 src/Simplex/Chat/Store/Migrations.hs          |  4 +-
 5 files changed, 66 insertions(+), 70 deletions(-)
 create mode 100644 src/Simplex/Chat/Migrations/M20231114_remote_control.hs
 delete mode 100644 src/Simplex/Chat/Migrations/M20231114_remote_controller.hs

diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index d40d3239d..abcfcc4c4 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -123,7 +123,7 @@ library
       Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
       Simplex.Chat.Migrations.M20231107_indexes
       Simplex.Chat.Migrations.M20231113_group_forward
-      Simplex.Chat.Migrations.M20231114_remote_controller
+      Simplex.Chat.Migrations.M20231114_remote_control
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared
diff --git a/src/Simplex/Chat/Migrations/M20231114_remote_control.hs b/src/Simplex/Chat/Migrations/M20231114_remote_control.hs
new file mode 100644
index 000000000..e716b2aa6
--- /dev/null
+++ b/src/Simplex/Chat/Migrations/M20231114_remote_control.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20231114_remote_control where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20231114_remote_control :: Query
+m20231114_remote_control =
+  [sql|
+CREATE TABLE remote_hosts ( -- e.g., mobiles known to a desktop app
+  remote_host_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  host_device_name TEXT NOT NULL,
+  store_path TEXT NOT NULL, -- relative folder name for host files
+  ca_key BLOB NOT NULL,
+  ca_cert BLOB NOT NULL,
+  id_key BLOB NOT NULL, -- long-term/identity signing key
+  host_fingerprint BLOB NOT NULL, -- remote host CA cert fingerprint, set when connected
+  host_dh_pub BLOB NOT NULL -- last session DH key
+);
+
+CREATE UNIQUE INDEX idx_remote_hosts_host_fingerprint ON remote_hosts(host_fingerprint);
+
+CREATE TABLE remote_controllers ( -- e.g., desktops known to a mobile app
+  remote_ctrl_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  ctrl_device_name TEXT NOT NULL,
+  ca_key BLOB NOT NULL,
+  ca_cert BLOB NOT NULL,
+  ctrl_fingerprint BLOB NOT NULL, -- remote controller CA cert fingerprint, set when connected
+  id_pub BLOB NOT NULL, -- remote controller long-term/identity key to verify signatures
+  dh_priv_key BLOB NOT NULL, -- last session DH key
+  prev_dh_priv_key BLOB -- previous session DH key
+);
+
+CREATE UNIQUE INDEX idx_remote_controllers_ctrl_fingerprint ON remote_controllers(ctrl_fingerprint);
+|]
+
+down_m20231114_remote_control :: Query
+down_m20231114_remote_control =
+  [sql|
+DROP INDEX idx_remote_hosts_host_fingerprint;
+DROP INDEX idx_remote_controllers_ctrl_fingerprint;
+DROP TABLE remote_hosts;
+DROP TABLE remote_controllers;
+|]
diff --git a/src/Simplex/Chat/Migrations/M20231114_remote_controller.hs b/src/Simplex/Chat/Migrations/M20231114_remote_controller.hs
deleted file mode 100644
index a8e92a998..000000000
--- a/src/Simplex/Chat/Migrations/M20231114_remote_controller.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module Simplex.Chat.Migrations.M20231114_remote_controller where
-
-import Database.SQLite.Simple (Query)
-import Database.SQLite.Simple.QQ (sql)
-
-m20231114_remote_controller :: Query
-m20231114_remote_controller =
-  [sql|
-CREATE TABLE remote_hosts ( -- hosts known to a controlling app
-  remote_host_id INTEGER PRIMARY KEY AUTOINCREMENT,
-  host_device_name TEXT NOT NULL,
-  store_path TEXT NOT NULL, -- file path for host files relative to app storage (must not contain "/")
-  -- RCHostPairing
-  ca_key BLOB NOT NULL, -- private key to sign session certificates
-  ca_cert BLOB NOT NULL, -- root certificate
-  id_key BLOB NOT NULL, -- long-term/identity signing key
-  -- KnownHostPairing
-  host_fingerprint BLOB NOT NULL, -- pinned remote host CA, set when connected
-  -- stored host session key
-  host_dh_pub BLOB NOT NULL, -- session DH key
-  UNIQUE (host_fingerprint) ON CONFLICT FAIL
-);
-
-CREATE TABLE remote_controllers ( -- controllers known to a hosting app
-  remote_ctrl_id INTEGER PRIMARY KEY AUTOINCREMENT,
-  ctrl_device_name TEXT NOT NULL,
-  -- RCCtrlPairing
-  ca_key BLOB NOT NULL, -- CA key
-  ca_cert BLOB NOT NULL, -- CA certificate for TLS clients
-  ctrl_fingerprint BLOB NOT NULL, -- remote controller CA, set when connected
-  id_pub BLOB NOT NULL, -- remote controller long-term/identity key to verify signatures
-  -- stored session key, commited on connection confirmation
-  dh_priv_key BLOB NOT NULL, -- session DH key
-  -- prev session key
-  prev_dh_priv_key BLOB, -- previous session DH key
-  UNIQUE (ctrl_fingerprint) ON CONFLICT FAIL
-);
-|]
-
-down_m20231114_remote_controller :: Query
-down_m20231114_remote_controller =
-  [sql|
-DROP TABLE remote_hosts;
-DROP TABLE remote_controllers;
-|]
diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql
index f6aed7698..bc441ec6f 100644
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -528,34 +528,26 @@ CREATE TABLE IF NOT EXISTS "received_probes"(
   updated_at TEXT CHECK(updated_at NOT NULL)
 );
 CREATE TABLE remote_hosts(
-  -- hosts known to a controlling app
+  -- e.g., mobiles known to a desktop app
   remote_host_id INTEGER PRIMARY KEY AUTOINCREMENT,
   host_device_name TEXT NOT NULL,
-  store_path TEXT NOT NULL, -- file path for host files relative to app storage(must not contain "/")
-  -- RCHostPairing
-  ca_key BLOB NOT NULL, -- private key to sign session certificates
-  ca_cert BLOB NOT NULL, -- root certificate
+  store_path TEXT NOT NULL, -- relative folder name for host files
+  ca_key BLOB NOT NULL,
+  ca_cert BLOB NOT NULL,
   id_key BLOB NOT NULL, -- long-term/identity signing key
-  -- KnownHostPairing
-  host_fingerprint BLOB NOT NULL, -- pinned remote host CA, set when connected
-  -- stored host session key
-  host_dh_pub BLOB NOT NULL, -- session DH key
-  UNIQUE(host_fingerprint) ON CONFLICT FAIL
+  host_fingerprint BLOB NOT NULL, -- remote host CA cert fingerprint, set when connected
+  host_dh_pub BLOB NOT NULL -- last session DH key
 );
 CREATE TABLE remote_controllers(
-  -- controllers known to a hosting app
+  -- e.g., desktops known to a mobile app
   remote_ctrl_id INTEGER PRIMARY KEY AUTOINCREMENT,
   ctrl_device_name TEXT NOT NULL,
-  -- RCCtrlPairing
-  ca_key BLOB NOT NULL, -- CA key
-  ca_cert BLOB NOT NULL, -- CA certificate for TLS clients
-  ctrl_fingerprint BLOB NOT NULL, -- remote controller CA, set when connected
+  ca_key BLOB NOT NULL,
+  ca_cert BLOB NOT NULL,
+  ctrl_fingerprint BLOB NOT NULL, -- remote controller CA cert fingerprint, set when connected
   id_pub BLOB NOT NULL, -- remote controller long-term/identity key to verify signatures
-  -- stored session key, commited on connection confirmation
-  dh_priv_key BLOB NOT NULL, -- session DH key
-  -- prev session key
-  prev_dh_priv_key BLOB, -- previous session DH key
-  UNIQUE(ctrl_fingerprint) ON CONFLICT FAIL
+  dh_priv_key BLOB NOT NULL, -- last session DH key
+  prev_dh_priv_key BLOB -- previous session DH key
 );
 CREATE INDEX contact_profiles_index ON contact_profiles(
   display_name,
@@ -808,3 +800,9 @@ CREATE INDEX idx_messages_group_id_shared_msg_id ON messages(
 CREATE INDEX idx_chat_items_forwarded_by_group_member_id ON chat_items(
   forwarded_by_group_member_id
 );
+CREATE UNIQUE INDEX idx_remote_hosts_host_fingerprint ON remote_hosts(
+  host_fingerprint
+);
+CREATE UNIQUE INDEX idx_remote_controllers_ctrl_fingerprint ON remote_controllers(
+  ctrl_fingerprint
+);
diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs
index f7b10971c..7b9ead1b1 100644
--- a/src/Simplex/Chat/Store/Migrations.hs
+++ b/src/Simplex/Chat/Store/Migrations.hs
@@ -89,7 +89,7 @@ import Simplex.Chat.Migrations.M20231019_indexes
 import Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
 import Simplex.Chat.Migrations.M20231107_indexes
 import Simplex.Chat.Migrations.M20231113_group_forward
-import Simplex.Chat.Migrations.M20231114_remote_controller
+import Simplex.Chat.Migrations.M20231114_remote_control
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -179,7 +179,7 @@ schemaMigrations =
     ("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received),
     ("20231107_indexes", m20231107_indexes, Just down_m20231107_indexes),
     ("20231113_group_forward", m20231113_group_forward, Just down_m20231113_group_forward),
-    ("20231114_remote_controller", m20231114_remote_controller, Just down_m20231114_remote_controller)
+    ("20231114_remote_control", m20231114_remote_control, Just down_m20231114_remote_control)
   ]
 
 -- | The list of migrations in ascending order by date

From ca8833c0c1599dde3ad4631c7f91cdb8bbce819b Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 18 Nov 2023 20:11:30 +0000
Subject: [PATCH 59/69] desktop: sending and receiving files via connected
 mobile (#3365)

* desktop: support remote files (WIP)

* working with remote files locally

* better

* working with remote file downloads

* sending files

* fixes of loading files in some situations

* image compression

* constant for remote hosts

* refactor

---------

Co-authored-by: Avently <7953703+avently@users.noreply.github.com>
---
 .../simplex/common/platform/Files.android.kt  |  2 +
 .../common/views/helpers/Utils.android.kt     |  2 +-
 .../chat/simplex/common/model/ChatModel.kt    | 59 +++++++++++++++-
 .../chat/simplex/common/model/SimpleXAPI.kt   | 30 ++++++---
 .../chat/simplex/common/platform/Files.kt     | 19 +++++-
 .../simplex/common/views/chat/ChatView.kt     |  7 +-
 .../simplex/common/views/chat/ComposeView.kt  | 67 +++++++++++++------
 .../common/views/chat/item/CIFileView.kt      | 18 +++--
 .../common/views/chat/item/CIImageView.kt     | 25 +++++--
 .../common/views/chat/item/CIVIdeoView.kt     | 18 ++++-
 .../common/views/chat/item/CIVoiceView.kt     | 23 +++++--
 .../common/views/chat/item/ChatItemView.kt    | 41 ++++++++----
 .../common/views/helpers/AlertManager.kt      | 19 ++++++
 .../simplex/common/views/helpers/Utils.kt     | 34 +++++++---
 .../commonMain/resources/MR/base/strings.xml  |  2 +
 .../common/model/NtfManager.desktop.kt        |  2 +-
 .../simplex/common/platform/Files.desktop.kt  |  2 +
 .../views/chat/item/CIImageView.desktop.kt    |  2 -
 .../views/chat/item/ChatItemView.desktop.kt   | 36 +++++++---
 .../common/views/helpers/Utils.desktop.kt     | 23 +++++--
 20 files changed, 334 insertions(+), 97 deletions(-)

diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/Files.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/Files.android.kt
index 161bc51e6..dfc8c1d4e 100644
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/Files.android.kt
+++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/Files.android.kt
@@ -23,6 +23,8 @@ actual val agentDatabaseFileName: String = "files_agent.db"
 
 actual val databaseExportDir: File = androidAppContext.cacheDir
 
+actual val remoteHostsDir: File = File(tmpDir.absolutePath + File.separator + "remote_hosts")
+
 actual fun desktopOpenDatabaseDir() {}
 
 @Composable
diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/helpers/Utils.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/helpers/Utils.android.kt
index f2c2f393a..5c7273ecc 100644
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/helpers/Utils.android.kt
+++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/helpers/Utils.android.kt
@@ -167,7 +167,7 @@ actual fun getAppFileUri(fileName: String): URI =
   FileProvider.getUriForFile(androidAppContext, "$APPLICATION_ID.provider", if (File(fileName).isAbsolute) File(fileName) else File(getAppFilePath(fileName))).toURI()
 
 // https://developer.android.com/training/data-storage/shared/documents-files#bitmap
-actual fun getLoadedImage(file: CIFile?): Pair<ImageBitmap, ByteArray>? {
+actual suspend fun getLoadedImage(file: CIFile?): Pair<ImageBitmap, ByteArray>? {
   val filePath = getLoadedFilePath(file)
   return if (filePath != null && file != null) {
     try {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
index c3ec33e0c..86e507230 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
@@ -1,7 +1,8 @@
 package chat.simplex.common.model
 
-import androidx.compose.material.MaterialTheme
+import androidx.compose.material.*
 import androidx.compose.runtime.*
+import androidx.compose.runtime.snapshots.SnapshotStateList
 import androidx.compose.ui.graphics.Color
 import androidx.compose.ui.text.SpanStyle
 import androidx.compose.ui.text.font.*
@@ -596,6 +597,8 @@ object ChatModel {
     }
     terminalItems.add(item)
   }
+
+  fun connectedToRemote(): Boolean = currentRemoteHost.value != null
 }
 
 enum class ChatType(val type: String) {
@@ -2224,7 +2227,7 @@ enum class MREmojiChar(val value: String) {
 }
 
 @Serializable
-class CIFile(
+data class CIFile(
   val fileId: Long,
   val fileName: String,
   val fileSize: Long,
@@ -2268,6 +2271,39 @@ class CIFile(
     is CIFileStatus.Invalid -> null
   }
 
+  /**
+   * DO NOT CALL this function in compose scope, [LaunchedEffect], [DisposableEffect] and so on. Only with [withBGApi] or [runBlocking].
+   * Otherwise, it will be canceled when moving to another screen/item/view, etc
+   * */
+  suspend fun loadRemoteFile(allowToShowAlert: Boolean): Boolean {
+    val rh = chatModel.currentRemoteHost.value
+    val user = chatModel.currentUser.value
+    if (rh == null || user == null || fileSource == null || !loaded) return false
+    if (getLoadedFilePath(this) != null) return true
+    if (cachedRemoteFileRequests.contains(fileSource)) return false
+
+    val rf = RemoteFile(
+      userId = user.userId,
+      fileId = fileId,
+      sent = fileStatus.sent,
+      fileSource = fileSource
+    )
+    cachedRemoteFileRequests.add(fileSource)
+    val showAlert = fileSize > 5_000_000 && allowToShowAlert
+    if (showAlert) {
+      AlertManager.shared.showAlertMsgWithProgress(
+        title = generalGetString(MR.strings.loading_remote_file_title),
+        text = generalGetString(MR.strings.loading_remote_file_desc)
+      )
+    }
+    val res = chatModel.controller.getRemoteFile(rh.remoteHostId, rf)
+    cachedRemoteFileRequests.remove(fileSource)
+    if (showAlert) {
+      AlertManager.shared.hideAlert()
+    }
+    return res
+  }
+
   companion object {
     fun getSample(
       fileId: Long = 1,
@@ -2277,6 +2313,8 @@ class CIFile(
       fileStatus: CIFileStatus = CIFileStatus.RcvComplete
     ): CIFile =
       CIFile(fileId = fileId, fileName = fileName, fileSize = fileSize, fileSource = if (filePath == null) null else CryptoFile.plain(filePath), fileStatus = fileStatus, fileProtocol = FileProtocol.XFTP)
+
+    val cachedRemoteFileRequests = SnapshotStateList<CryptoFile>()
   }
 }
 
@@ -2308,6 +2346,8 @@ data class CryptoFile(
 
   companion object {
     fun plain(f: String): CryptoFile = CryptoFile(f, null)
+
+    fun desktopPlain(f: URI): CryptoFile = CryptoFile(f.rawPath, null)
   }
 }
 
@@ -2370,6 +2410,21 @@ sealed class CIFileStatus {
   @Serializable @SerialName("rcvCancelled") object RcvCancelled: CIFileStatus()
   @Serializable @SerialName("rcvError") object RcvError: CIFileStatus()
   @Serializable @SerialName("invalid") class Invalid(val text: String): CIFileStatus()
+
+  val sent: Boolean get() = when (this) {
+    is SndStored -> true
+    is SndTransfer -> true
+    is SndComplete -> true
+    is SndCancelled -> true
+    is SndError -> true
+    is RcvInvitation -> false
+    is RcvAccepted -> false
+    is RcvTransfer -> false
+    is RcvComplete -> false
+    is RcvCancelled -> false
+    is RcvError -> false
+    is Invalid -> false
+  }
 }
 
 @Suppress("SERIALIZER_TYPE_INCOMPATIBLE")
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
index 98c48dbfb..0d3b16fa8 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
@@ -24,6 +24,7 @@ import kotlinx.serialization.*
 import kotlinx.serialization.builtins.MapSerializer
 import kotlinx.serialization.builtins.serializer
 import kotlinx.serialization.json.*
+import java.io.File
 import java.util.Date
 
 typealias ChatCtrl = Long
@@ -339,6 +340,9 @@ object ChatController {
       apiSetNetworkConfig(getNetCfg())
       apiSetTempFolder(coreTmpDir.absolutePath)
       apiSetFilesFolder(appFilesDir.absolutePath)
+      if (appPlatform.isDesktop) {
+        apiSetRemoteHostsFolder(remoteHostsDir.absolutePath)
+      }
       apiSetXFTPConfig(getXFTPCfg())
       apiSetEncryptLocalFiles(appPrefs.privacyEncryptLocalFiles.get())
       val justStarted = apiStartChat()
@@ -418,14 +422,14 @@ object ChatController {
     }
   }
 
-  suspend fun sendCmd(cmd: CC): CR {
+  suspend fun sendCmd(cmd: CC, customRhId: Long? = null): CR {
     val ctrl = ctrl ?: throw Exception("Controller is not initialized")
 
     return withContext(Dispatchers.IO) {
       val c = cmd.cmdString
       chatModel.addTerminalItem(TerminalItem.cmd(cmd.obfuscated))
       Log.d(TAG, "sendCmd: ${cmd.cmdType}")
-      val rhId = chatModel.currentRemoteHost.value?.remoteHostId?.toInt() ?: -1
+      val rhId = customRhId?.toInt() ?: chatModel.currentRemoteHost.value?.remoteHostId?.toInt() ?: -1
       val json = if (rhId == -1) chatSendCmd(ctrl, c) else chatSendRemoteCmd(ctrl, rhId, c)
       val r = APIResponse.decodeStr(json)
       Log.d(TAG, "sendCmd response type ${r.resp.responseType}")
@@ -559,6 +563,12 @@ object ChatController {
     throw Error("failed to set files folder: ${r.responseType} ${r.details}")
   }
 
+  private suspend fun apiSetRemoteHostsFolder(remoteHostsFolder: String) {
+    val r = sendCmd(CC.SetRemoteHostsFolder(remoteHostsFolder))
+    if (r is CR.CmdOk) return
+    throw Error("failed to set remote hosts folder: ${r.responseType} ${r.details}")
+  }
+
   suspend fun apiSetXFTPConfig(cfg: XFTPFileConfig?) {
     val r = sendCmd(CC.ApiSetXFTPConfig(cfg))
     if (r is CR.CmdOk) return
@@ -609,9 +619,9 @@ object ChatController {
     return null
   }
 
-  suspend fun apiSendMessage(type: ChatType, id: Long, file: CryptoFile? = null, quotedItemId: Long? = null, mc: MsgContent, live: Boolean = false, ttl: Int? = null): AChatItem? {
+  suspend fun apiSendMessage(rhId: Long?, type: ChatType, id: Long, file: CryptoFile? = null, quotedItemId: Long? = null, mc: MsgContent, live: Boolean = false, ttl: Int? = null): AChatItem? {
     val cmd = CC.ApiSendMessage(type, id, file, quotedItemId, mc, live, ttl)
-    val r = sendCmd(cmd)
+    val r = sendCmd(cmd, rhId)
     return when (r) {
       is CR.NewChatItem -> r.chatItem
       else -> {
@@ -1142,8 +1152,9 @@ object ChatController {
     return false
   }
 
-  suspend fun apiReceiveFile(fileId: Long, encrypted: Boolean, inline: Boolean? = null, auto: Boolean = false): AChatItem? {
-    val r = sendCmd(CC.ReceiveFile(fileId, encrypted, inline))
+  suspend fun apiReceiveFile(rhId: Long?, fileId: Long, encrypted: Boolean, inline: Boolean? = null, auto: Boolean = false): AChatItem? {
+    // -1 here is to override default behavior of providing current remote host id because file can be asked by local device while remote is connected
+    val r = sendCmd(CC.ReceiveFile(fileId, encrypted, inline), rhId ?: -1)
     return when (r) {
       is CR.RcvFileAccepted -> r.chatItem
       is CR.RcvFileAcceptedSndCancelled -> {
@@ -1868,7 +1879,7 @@ object ChatController {
   }
 
   suspend fun receiveFile(rhId: Long?, user: UserLike, fileId: Long, encrypted: Boolean, auto: Boolean = false) {
-    val chatItem = apiReceiveFile(fileId, encrypted = encrypted, auto = auto)
+    val chatItem = apiReceiveFile(rhId, fileId, encrypted = encrypted, auto = auto)
     if (chatItem != null) {
       chatItemSimpleUpdate(rhId, user, chatItem)
     }
@@ -2035,6 +2046,7 @@ sealed class CC {
   class ApiStopChat: CC()
   class SetTempFolder(val tempFolder: String): CC()
   class SetFilesFolder(val filesFolder: String): CC()
+  class SetRemoteHostsFolder(val remoteHostsFolder: String): CC()
   class ApiSetXFTPConfig(val config: XFTPFileConfig?): CC()
   class ApiSetEncryptLocalFiles(val enable: Boolean): CC()
   class ApiExportArchive(val config: ArchiveConfig): CC()
@@ -2161,6 +2173,7 @@ sealed class CC {
     is ApiStopChat -> "/_stop"
     is SetTempFolder -> "/_temp_folder $tempFolder"
     is SetFilesFolder -> "/_files_folder $filesFolder"
+    is SetRemoteHostsFolder -> "/remote_hosts_folder $remoteHostsFolder"
     is ApiSetXFTPConfig -> if (config != null) "/_xftp on ${json.encodeToString(config)}" else "/_xftp off"
     is ApiSetEncryptLocalFiles -> "/_files_encrypt ${onOff(enable)}"
     is ApiExportArchive -> "/_db export ${json.encodeToString(config)}"
@@ -2259,7 +2272,7 @@ sealed class CC {
     is DeleteRemoteHost -> "/delete remote host $remoteHostId"
     is StoreRemoteFile ->
       "/store remote file $remoteHostId " +
-          (if (storeEncrypted == null) "" else " encrypt=${onOff(storeEncrypted)}") +
+          (if (storeEncrypted == null) "" else " encrypt=${onOff(storeEncrypted)} ") +
           localPath
     is GetRemoteFile -> "/get remote file $remoteHostId ${json.encodeToString(file)}"
     is ConnectRemoteCtrl -> "/connect remote ctrl $xrcpInvitation"
@@ -2290,6 +2303,7 @@ sealed class CC {
     is ApiStopChat -> "apiStopChat"
     is SetTempFolder -> "setTempFolder"
     is SetFilesFolder -> "setFilesFolder"
+    is SetRemoteHostsFolder -> "setRemoteHostsFolder"
     is ApiSetXFTPConfig -> "apiSetXFTPConfig"
     is ApiSetEncryptLocalFiles -> "apiSetEncryptLocalFiles"
     is ApiExportArchive -> "apiExportArchive"
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Files.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Files.kt
index 71a9f204f..877356e43 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Files.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Files.kt
@@ -24,6 +24,8 @@ expect val agentDatabaseFileName: String
 * */
 expect val databaseExportDir: File
 
+expect val remoteHostsDir: File
+
 expect fun desktopOpenDatabaseDir()
 
 fun copyFileToFile(from: File, to: URI, finally: () -> Unit) {
@@ -59,14 +61,20 @@ fun copyBytesToFile(bytes: ByteArrayInputStream, to: URI, finally: () -> Unit) {
 }
 
 fun getAppFilePath(fileName: String): String {
-  return appFilesDir.absolutePath + File.separator + fileName
+  val rh = chatModel.currentRemoteHost.value
+  val s = File.separator
+  return if (rh == null) {
+    appFilesDir.absolutePath + s + fileName
+  } else {
+    remoteHostsDir.absolutePath + s + rh.storePath + s + "simplex_v1_files" + s + fileName
+  }
 }
 
 fun getLoadedFilePath(file: CIFile?): String? {
   val f = file?.fileSource?.filePath
   return if (f != null && file.loaded) {
     val filePath = getAppFilePath(f)
-    if (File(filePath).exists()) filePath else null
+    if (fileReady(file, filePath)) filePath else null
   } else {
     null
   }
@@ -76,12 +84,17 @@ fun getLoadedFileSource(file: CIFile?): CryptoFile? {
   val f = file?.fileSource?.filePath
   return if (f != null && file.loaded) {
     val filePath = getAppFilePath(f)
-    if (File(filePath).exists()) file.fileSource else null
+    if (fileReady(file, filePath)) file.fileSource else null
   } else {
     null
   }
 }
 
+private fun fileReady(file: CIFile, filePath: String) =
+  File(filePath).exists() &&
+  !CIFile.cachedRemoteFileRequests.contains(file.fileSource)
+  && File(filePath).length() >= file.fileSize
+
 /**
 * [rememberedValue] is used in `remember(rememberedValue)`. So when the value changes, file saver will update a callback function
 * */
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt
index 527d68a52..7097c77d1 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt
@@ -499,6 +499,7 @@ fun ChatLayout(
         enabled = !attachmentDisabled.value && rememberUpdatedState(chat.userCanSend).value,
         onFiles = { paths -> composeState.onFilesAttached(paths.map { URI.create(it) }) },
         onImage = {
+          // TODO: file is not saved anywhere?!
           val tmpFile = File.createTempFile("image", ".bmp", tmpDir)
           tmpFile.deleteOnExit()
           chatModel.filesToDelete.add(tmpFile)
@@ -1300,7 +1301,7 @@ private fun providerForGallery(
   scrollTo: (Int) -> Unit
 ): ImageGalleryProvider {
   fun canShowMedia(item: ChatItem): Boolean =
-    (item.content.msgContent is MsgContent.MCImage || item.content.msgContent is MsgContent.MCVideo) && (item.file?.loaded == true && getLoadedFilePath(item.file) != null)
+    (item.content.msgContent is MsgContent.MCImage || item.content.msgContent is MsgContent.MCVideo) && (item.file?.loaded == true && (getLoadedFilePath(item.file) != null || chatModel.connectedToRemote()))
 
   fun item(skipInternalIndex: Int, initialChatId: Long): Pair<Int, ChatItem>? {
     var processedInternalIndex = -skipInternalIndex.sign
@@ -1327,7 +1328,7 @@ private fun providerForGallery(
       val item = item(internalIndex, initialChatId)?.second ?: return null
       return when (item.content.msgContent) {
         is MsgContent.MCImage -> {
-          val res = getLoadedImage(item.file)
+          val res = runBlocking { getLoadedImage(item.file) }
           val filePath = getLoadedFilePath(item.file)
           if (res != null && filePath != null) {
             val (imageBitmap: ImageBitmap, data: ByteArray) = res
@@ -1335,7 +1336,7 @@ private fun providerForGallery(
           } else null
         }
         is MsgContent.MCVideo -> {
-          val filePath = getLoadedFilePath(item.file)
+          val filePath = if (chatModel.connectedToRemote() && item.file?.loaded == true) getAppFilePath(item.file.fileName) else getLoadedFilePath(item.file)
           if (filePath != null) {
             val uri = getAppFileUri(filePath.substringAfterLast(File.separator))
             ProviderMedia.Video(uri, (item.content.msgContent as MsgContent.MCVideo).image)
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ComposeView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ComposeView.kt
index 959ded42b..a9b7014d5 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ComposeView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ComposeView.kt
@@ -15,6 +15,8 @@ import dev.icerock.moko.resources.compose.painterResource
 import dev.icerock.moko.resources.compose.stringResource
 import androidx.compose.ui.unit.dp
 import chat.simplex.common.model.*
+import chat.simplex.common.model.ChatModel.controller
+import chat.simplex.common.model.ChatModel.filesToDelete
 import chat.simplex.common.platform.*
 import chat.simplex.common.ui.theme.Indigo
 import chat.simplex.common.ui.theme.isSystemInDarkTheme
@@ -349,8 +351,9 @@ fun ComposeView(
     }
   }
 
-  suspend fun send(cInfo: ChatInfo, mc: MsgContent, quoted: Long?, file: CryptoFile? = null, live: Boolean = false, ttl: Int?): ChatItem? {
+  suspend fun send(rhId: Long?, cInfo: ChatInfo, mc: MsgContent, quoted: Long?, file: CryptoFile? = null, live: Boolean = false, ttl: Int?): ChatItem? {
     val aChatItem = chatModel.controller.apiSendMessage(
+      rhId = rhId,
       type = cInfo.chatType,
       id = cInfo.apiId,
       file = file,
@@ -447,15 +450,23 @@ fun ComposeView(
     } else {
       val msgs: ArrayList<MsgContent> = ArrayList()
       val files: ArrayList<CryptoFile> = ArrayList()
+      val remoteHost = chatModel.currentRemoteHost.value
       when (val preview = cs.preview) {
         ComposePreview.NoPreview -> msgs.add(MsgContent.MCText(msgText))
         is ComposePreview.CLinkPreview -> msgs.add(checkLinkPreview())
         is ComposePreview.MediaPreview -> {
           preview.content.forEachIndexed { index, it ->
+            val encrypted = chatController.appPrefs.privacyEncryptLocalFiles.get()
             val file = when (it) {
-              is UploadContent.SimpleImage -> saveImage(it.uri, encrypted = chatController.appPrefs.privacyEncryptLocalFiles.get())
-              is UploadContent.AnimatedImage -> saveAnimImage(it.uri, encrypted = chatController.appPrefs.privacyEncryptLocalFiles.get())
-              is UploadContent.Video -> saveFileFromUri(it.uri, encrypted = false)
+              is UploadContent.SimpleImage ->
+                if (remoteHost == null) saveImage(it.uri, encrypted = encrypted)
+                else desktopSaveImageInTmp(it.uri)
+              is UploadContent.AnimatedImage ->
+                if (remoteHost == null) saveAnimImage(it.uri, encrypted = encrypted)
+                else CryptoFile.desktopPlain(it.uri)
+              is UploadContent.Video ->
+                if (remoteHost == null) saveFileFromUri(it.uri, encrypted = false)
+                else CryptoFile.desktopPlain(it.uri)
             }
             if (file != null) {
               files.add(file)
@@ -470,22 +481,32 @@ fun ComposeView(
         is ComposePreview.VoicePreview -> {
           val tmpFile = File(preview.voice)
           AudioPlayer.stop(tmpFile.absolutePath)
-          val actualFile = File(getAppFilePath(tmpFile.name.replaceAfter(RecorderInterface.extension, "")))
-          files.add(withContext(Dispatchers.IO) {
-            if (chatController.appPrefs.privacyEncryptLocalFiles.get()) {
-              val args = encryptCryptoFile(tmpFile.absolutePath, actualFile.absolutePath)
-              tmpFile.delete()
-              CryptoFile(actualFile.name, args)
-            } else {
-              Files.move(tmpFile.toPath(), actualFile.toPath())
-              CryptoFile.plain(actualFile.name)
-            }
-          })
-          deleteUnusedFiles()
+          if (remoteHost == null) {
+            val actualFile = File(getAppFilePath(tmpFile.name.replaceAfter(RecorderInterface.extension, "")))
+            files.add(withContext(Dispatchers.IO) {
+              if (chatController.appPrefs.privacyEncryptLocalFiles.get()) {
+                val args = encryptCryptoFile(tmpFile.absolutePath, actualFile.absolutePath)
+                tmpFile.delete()
+                CryptoFile(actualFile.name, args)
+              } else {
+                Files.move(tmpFile.toPath(), actualFile.toPath())
+                CryptoFile.plain(actualFile.name)
+              }
+            })
+            deleteUnusedFiles()
+          } else {
+            files.add(CryptoFile.plain(tmpFile.absolutePath))
+            // It will be deleted on JVM shutdown or next start (if the app crashes unexpectedly)
+            filesToDelete.remove(tmpFile)
+          }
           msgs.add(MsgContent.MCVoice(if (msgs.isEmpty()) msgText else "", preview.durationMs / 1000))
         }
         is ComposePreview.FilePreview -> {
-          val file = saveFileFromUri(preview.uri, encrypted = chatController.appPrefs.privacyEncryptLocalFiles.get())
+          val file = if (remoteHost == null) {
+            saveFileFromUri(preview.uri, encrypted = chatController.appPrefs.privacyEncryptLocalFiles.get())
+          } else {
+            CryptoFile.desktopPlain(preview.uri)
+          }
           if (file != null) {
             files.add((file))
             msgs.add(MsgContent.MCFile(if (msgs.isEmpty()) msgText else ""))
@@ -499,7 +520,15 @@ fun ComposeView(
       sent = null
       msgs.forEachIndexed { index, content ->
         if (index > 0) delay(100)
-        sent = send(cInfo, content, if (index == 0) quotedItemId else null, files.getOrNull(index),
+        var file = files.getOrNull(index)
+        if (remoteHost != null && file != null) {
+          file = controller.storeRemoteFile(
+            rhId = remoteHost.remoteHostId,
+            storeEncrypted = if (content is MsgContent.MCVideo) false else null,
+            localPath = file.filePath
+          )
+        }
+        sent = send(remoteHost?.remoteHostId, cInfo, content, if (index == 0) quotedItemId else null, file,
           live = if (content !is MsgContent.MCVoice && index == msgs.lastIndex) live else false,
           ttl = ttl
         )
@@ -509,7 +538,7 @@ fun ComposeView(
             cs.preview is ComposePreview.FilePreview ||
             cs.preview is ComposePreview.VoicePreview)
       ) {
-        sent = send(cInfo, MsgContent.MCText(msgText), quotedItemId, null, live, ttl)
+        sent = send(remoteHost?.remoteHostId, cInfo, MsgContent.MCText(msgText), quotedItemId, null, live, ttl)
       }
     }
     clearState(live)
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.kt
index 57dcd16cb..0d439f123 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.kt
@@ -94,13 +94,19 @@ fun CIFileView(
               )
           }
         is CIFileStatus.RcvComplete -> {
-          val filePath = getLoadedFilePath(file)
-          if (filePath != null) {
-            withApi {
-              saveFileLauncher.launch(file.fileName)
+          withBGApi {
+            var filePath = getLoadedFilePath(file)
+            if (chatModel.connectedToRemote() && filePath == null) {
+              file.loadRemoteFile(true)
+              filePath = getLoadedFilePath(file)
+            }
+            if (filePath != null) {
+              withApi {
+                saveFileLauncher.launch(file.fileName)
+              }
+            } else {
+              showToast(generalGetString(MR.strings.file_not_found))
             }
-          } else {
-            showToast(generalGetString(MR.strings.file_not_found))
           }
         }
         else -> {}
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIImageView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIImageView.kt
index 23d1f1d0c..8b0b2debc 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIImageView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIImageView.kt
@@ -22,6 +22,9 @@ import chat.simplex.common.platform.*
 import chat.simplex.common.ui.theme.DEFAULT_MAX_IMAGE_WIDTH
 import chat.simplex.res.MR
 import dev.icerock.moko.resources.StringResource
+import kotlinx.coroutines.flow.collect
+import kotlinx.coroutines.flow.distinctUntilChanged
+import kotlinx.coroutines.runBlocking
 import java.io.File
 import java.net.URI
 
@@ -134,7 +137,7 @@ fun CIImageView(
     return false
   }
 
-  fun imageAndFilePath(file: CIFile?): Triple<ImageBitmap, ByteArray, String>? {
+  suspend fun imageAndFilePath(file: CIFile?): Triple<ImageBitmap, ByteArray, String>? {
     val res = getLoadedImage(file)
     if (res != null) {
       val (imageBitmap: ImageBitmap, data: ByteArray) = res
@@ -148,9 +151,23 @@ fun CIImageView(
     Modifier.layoutId(CHAT_IMAGE_LAYOUT_ID),
     contentAlignment = Alignment.TopEnd
   ) {
-    val res = remember(file) { imageAndFilePath(file) }
-    if (res != null) {
-      val (imageBitmap, data, _) = res
+    val res: MutableState<Triple<ImageBitmap, ByteArray, String>?> = remember {
+      mutableStateOf(
+        if (chatModel.connectedToRemote()) null else runBlocking { imageAndFilePath(file) }
+      )
+    }
+    if (chatModel.connectedToRemote()) {
+      LaunchedEffect(file, CIFile.cachedRemoteFileRequests.toList()) {
+        withBGApi {
+          if (res.value == null || res.value!!.third != getLoadedFilePath(file)) {
+            res.value = imageAndFilePath(file)
+          }
+        }
+      }
+    }
+    val loaded = res.value
+    if (loaded != null) {
+      val (imageBitmap, data, _) = loaded
       SimpleAndAnimatedImageView(data, imageBitmap, file, imageProvider, @Composable { painter, onClick -> ImageView(painter, onClick) })
     } else {
       imageView(base64ToBitmap(image), onClick = {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIVIdeoView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIVIdeoView.kt
index 996dc819f..04ec30735 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIVIdeoView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIVIdeoView.kt
@@ -21,6 +21,7 @@ import chat.simplex.common.views.helpers.*
 import chat.simplex.common.model.*
 import chat.simplex.common.platform.*
 import dev.icerock.moko.resources.StringResource
+import kotlinx.coroutines.flow.*
 import java.io.File
 import java.net.URI
 
@@ -37,10 +38,21 @@ fun CIVideoView(
     Modifier.layoutId(CHAT_IMAGE_LAYOUT_ID),
     contentAlignment = Alignment.TopEnd
   ) {
-    val filePath = remember(file) { getLoadedFilePath(file) }
     val preview = remember(image) { base64ToBitmap(image) }
-    if (file != null && filePath != null) {
-      val uri = remember(filePath) { getAppFileUri(filePath.substringAfterLast(File.separator))  }
+    val filePath = remember(file, CIFile.cachedRemoteFileRequests.toList()) { mutableStateOf(getLoadedFilePath(file)) }
+    if (chatModel.connectedToRemote()) {
+      LaunchedEffect(file) {
+        withBGApi {
+          if (file != null && file.loaded && getLoadedFilePath(file) == null) {
+            file.loadRemoteFile(false)
+            filePath.value = getLoadedFilePath(file)
+          }
+        }
+      }
+    }
+    val f = filePath.value
+    if (file != null && f != null) {
+      val uri = remember(filePath) { getAppFileUri(f.substringAfterLast(File.separator))  }
       val view = LocalMultiplatformView()
       VideoView(uri, file, preview, duration * 1000L, showMenu, onClick = {
         hideKeyboard(view)
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIVoiceView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIVoiceView.kt
index 941bc315b..0c8487458 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIVoiceView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIVoiceView.kt
@@ -22,7 +22,7 @@ import chat.simplex.common.views.helpers.*
 import chat.simplex.common.model.*
 import chat.simplex.common.platform.*
 import chat.simplex.res.MR
-import kotlinx.coroutines.flow.distinctUntilChanged
+import kotlinx.coroutines.flow.*
 
 // TODO refactor https://github.com/simplex-chat/simplex-chat/pull/1451#discussion_r1033429901
 
@@ -44,16 +44,25 @@ fun CIVoiceView(
   ) {
     if (file != null) {
       val f = file.fileSource?.filePath
-      val fileSource = remember(f, file.fileStatus) { getLoadedFileSource(file) }
+      val fileSource = remember(f, file.fileStatus, CIFile.cachedRemoteFileRequests.toList()) { mutableStateOf(getLoadedFileSource(file)) }
       var brokenAudio by rememberSaveable(f) { mutableStateOf(false) }
       val audioPlaying = rememberSaveable(f) { mutableStateOf(false) }
       val progress = rememberSaveable(f) { mutableStateOf(0) }
       val duration = rememberSaveable(f) { mutableStateOf(providedDurationSec * 1000) }
-      val play = {
-        if (fileSource != null) {
-          AudioPlayer.play(fileSource, audioPlaying, progress, duration, true)
-          brokenAudio = !audioPlaying.value
+      val play: () -> Unit = {
+        val playIfExists = {
+          if (fileSource.value != null) {
+            AudioPlayer.play(fileSource.value!!, audioPlaying, progress, duration, true)
+            brokenAudio = !audioPlaying.value
+          }
         }
+        if (chatModel.connectedToRemote() && fileSource.value == null) {
+          withBGApi {
+            file.loadRemoteFile(true)
+            fileSource.value = getLoadedFileSource(file)
+            playIfExists()
+          }
+        } else playIfExists()
       }
       val pause = {
         AudioPlayer.pause(audioPlaying, progress)
@@ -68,7 +77,7 @@ fun CIVoiceView(
         }
       }
       VoiceLayout(file, ci, text, audioPlaying, progress, duration, brokenAudio, sent, hasText, timedMessagesTTL, play, pause, longClick, receiveFile) {
-        AudioPlayer.seekTo(it, progress, fileSource?.filePath)
+        AudioPlayer.seekTo(it, progress, fileSource.value?.filePath)
       }
     } else {
       VoiceMsgIndicator(null, false, sent, hasText, null, null, false, {}, {}, longClick, receiveFile)
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt
index 095723a18..17e2fe044 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt
@@ -194,19 +194,34 @@ fun ChatItemView(
                   })
                 }
                 val clipboard = LocalClipboardManager.current
-                ItemAction(stringResource(MR.strings.share_verb), painterResource(MR.images.ic_share), onClick = {
-                  val fileSource = getLoadedFileSource(cItem.file)
-                  when {
-                    fileSource != null -> shareFile(cItem.text, fileSource)
-                    else -> clipboard.shareText(cItem.content.text)
-                  }
-                  showMenu.value = false
-                })
-                ItemAction(stringResource(MR.strings.copy_verb), painterResource(MR.images.ic_content_copy), onClick = {
-                  copyItemToClipboard(cItem, clipboard)
-                  showMenu.value = false
-                })
-                if ((cItem.content.msgContent is MsgContent.MCImage || cItem.content.msgContent is MsgContent.MCVideo || cItem.content.msgContent is MsgContent.MCFile || cItem.content.msgContent is MsgContent.MCVoice) && getLoadedFilePath(cItem.file) != null) {
+                val cachedRemoteReqs = remember { CIFile.cachedRemoteFileRequests }
+                val copyAndShareAllowed = cItem.file == null || !chatModel.connectedToRemote() || getLoadedFilePath(cItem.file) != null || !cachedRemoteReqs.contains(cItem.file.fileSource)
+                if (copyAndShareAllowed) {
+                  ItemAction(stringResource(MR.strings.share_verb), painterResource(MR.images.ic_share), onClick = {
+                    var fileSource = getLoadedFileSource(cItem.file)
+                    val shareIfExists = {
+                      when (val f = fileSource) {
+                        null -> clipboard.shareText(cItem.content.text)
+                        else -> shareFile(cItem.text, f)
+                      }
+                      showMenu.value = false
+                    }
+                    if (chatModel.connectedToRemote() && fileSource == null) {
+                      withBGApi {
+                        cItem.file?.loadRemoteFile(true)
+                        fileSource = getLoadedFileSource(cItem.file)
+                        shareIfExists()
+                      }
+                    } else shareIfExists()
+                  })
+                }
+                if (copyAndShareAllowed) {
+                  ItemAction(stringResource(MR.strings.copy_verb), painterResource(MR.images.ic_content_copy), onClick = {
+                    copyItemToClipboard(cItem, clipboard)
+                    showMenu.value = false
+                  })
+                }
+                if ((cItem.content.msgContent is MsgContent.MCImage || cItem.content.msgContent is MsgContent.MCVideo || cItem.content.msgContent is MsgContent.MCFile || cItem.content.msgContent is MsgContent.MCVoice) && (getLoadedFilePath(cItem.file) != null || (chatModel.connectedToRemote() && !cachedRemoteReqs.contains(cItem.file?.fileSource)))) {
                   SaveContentItemAction(cItem, saveFileLauncher, showMenu)
                 }
                 if (cItem.meta.editable && cItem.content.msgContent !is MsgContent.MCVoice && !live) {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/AlertManager.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/AlertManager.kt
index 35d5b8b3e..fa9c89384 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/AlertManager.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/AlertManager.kt
@@ -188,6 +188,25 @@ class AlertManager {
       )
     }
   }
+
+  fun showAlertMsgWithProgress(
+    title: String,
+    text: String? = null
+  ) {
+    showAlert {
+      AlertDialog(
+        onDismissRequest = this::hideAlert,
+        title = alertTitle(title),
+        text = alertText(text),
+        buttons = {
+          Box(Modifier.fillMaxWidth().height(72.dp).padding(bottom = DEFAULT_PADDING * 2), contentAlignment = Alignment.Center) {
+            CircularProgressIndicator(Modifier.size(36.dp).padding(4.dp), color = MaterialTheme.colors.secondary, strokeWidth = 3.dp)
+          }
+        }
+      )
+    }
+  }
+
   fun showAlertMsg(
     title: StringResource,
     text: StringResource? = null,
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt
index 5e64de2c5..7128d2185 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt
@@ -67,7 +67,7 @@ const val MAX_FILE_SIZE_XFTP: Long = 1_073_741_824 // 1GB
 expect fun getAppFileUri(fileName: String): URI
 
 // https://developer.android.com/training/data-storage/shared/documents-files#bitmap
-expect fun getLoadedImage(file: CIFile?): Pair<ImageBitmap, ByteArray>?
+expect suspend fun getLoadedImage(file: CIFile?): Pair<ImageBitmap, ByteArray>?
 
 expect fun getFileName(uri: URI): String?
 
@@ -106,7 +106,7 @@ fun saveImage(image: ImageBitmap, encrypted: Boolean): CryptoFile? {
   return try {
     val ext = if (image.hasAlpha()) "png" else "jpg"
     val dataResized = resizeImageToDataSize(image, ext == "png", maxDataSize = MAX_IMAGE_SIZE)
-    val destFileName = generateNewFileName("IMG", ext)
+    val destFileName = generateNewFileName("IMG", ext, File(getAppFilePath("")))
     val destFile = File(getAppFilePath(destFileName))
     if (encrypted) {
       val args = writeCryptoFile(destFile.absolutePath, dataResized.toByteArray())
@@ -124,6 +124,24 @@ fun saveImage(image: ImageBitmap, encrypted: Boolean): CryptoFile? {
   }
 }
 
+fun desktopSaveImageInTmp(uri: URI): CryptoFile? {
+  val image = getBitmapFromUri(uri) ?: return null
+  return try {
+    val ext = if (image.hasAlpha()) "png" else "jpg"
+    val dataResized = resizeImageToDataSize(image, ext == "png", maxDataSize = MAX_IMAGE_SIZE)
+    val destFileName = generateNewFileName("IMG", ext, tmpDir)
+    val destFile = File(tmpDir, destFileName)
+    val output = FileOutputStream(destFile)
+    dataResized.writeTo(output)
+    output.flush()
+    output.close()
+    CryptoFile.plain(destFile.absolutePath)
+  } catch (e: Exception) {
+    Log.e(TAG, "Util.kt desktopSaveImageInTmp error: ${e.stackTraceToString()}")
+    null
+  }
+}
+
 fun saveAnimImage(uri: URI, encrypted: Boolean): CryptoFile? {
   return try {
     val filename = getFileName(uri)?.lowercase()
@@ -134,7 +152,7 @@ fun saveAnimImage(uri: URI, encrypted: Boolean): CryptoFile? {
     }
     // Just in case the image has a strange extension
     if (ext.length < 3 || ext.length > 4) ext = "gif"
-    val destFileName = generateNewFileName("IMG", ext)
+    val destFileName = generateNewFileName("IMG", ext, File(getAppFilePath("")))
     val destFile = File(getAppFilePath(destFileName))
     if (encrypted) {
       val args = writeCryptoFile(destFile.absolutePath, uri.inputStream()?.readBytes() ?: return null)
@@ -156,7 +174,7 @@ fun saveFileFromUri(uri: URI, encrypted: Boolean, withAlertOnException: Boolean
     val inputStream = uri.inputStream()
     val fileToSave = getFileName(uri)
     return if (inputStream != null && fileToSave != null) {
-      val destFileName = uniqueCombine(fileToSave)
+      val destFileName = uniqueCombine(fileToSave, File(getAppFilePath("")))
       val destFile = File(getAppFilePath(destFileName))
       if (encrypted) {
         createTmpFileAndDelete { tmpFile ->
@@ -193,21 +211,21 @@ fun <T> createTmpFileAndDelete(onCreated: (File) -> T): T {
   }
 }
 
-fun generateNewFileName(prefix: String, ext: String): String {
+fun generateNewFileName(prefix: String, ext: String, dir: File): String {
   val sdf = SimpleDateFormat("yyyyMMdd_HHmmss", Locale.US)
   sdf.timeZone = TimeZone.getTimeZone("GMT")
   val timestamp = sdf.format(Date())
-  return uniqueCombine("${prefix}_$timestamp.$ext")
+  return uniqueCombine("${prefix}_$timestamp.$ext", dir)
 }
 
-fun uniqueCombine(fileName: String): String {
+fun uniqueCombine(fileName: String, dir: File): String {
   val orig = File(fileName)
   val name = orig.nameWithoutExtension
   val ext = orig.extension
   fun tryCombine(n: Int): String {
     val suffix = if (n == 0) "" else "_$n"
     val f = "$name$suffix.$ext"
-    return if (File(getAppFilePath(f)).exists()) tryCombine(n + 1) else f
+    return if (File(dir, f).exists()) tryCombine(n + 1) else f
   }
   return tryCombine(0)
 }
diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml
index b2f3e2f63..eb3b9207b 100644
--- a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml
+++ b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml
@@ -350,6 +350,8 @@
   <string name="file_saved">File saved</string>
   <string name="file_not_found">File not found</string>
   <string name="error_saving_file">Error saving file</string>
+  <string name="loading_remote_file_title">Loading the file </string>
+  <string name="loading_remote_file_desc">Please, wait while the file is being loaded from the linked mobile</string>
 
   <!-- Voice messages -->
   <string name="voice_message">Voice message</string>
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/model/NtfManager.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/model/NtfManager.desktop.kt
index 94e985328..cb34bdb3b 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/model/NtfManager.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/model/NtfManager.desktop.kt
@@ -113,7 +113,7 @@ object NtfManager {
 
   private fun prepareIconPath(icon: ImageBitmap?): String? = if (icon != null) {
     tmpDir.mkdir()
-    val newFile = File(tmpDir.absolutePath + File.separator + generateNewFileName("IMG", "png"))
+    val newFile = File(tmpDir.absolutePath + File.separator + generateNewFileName("IMG", "png", tmpDir))
     try {
       ImageIO.write(icon.toAwtImage(), "PNG", newFile.outputStream())
       newFile.absolutePath
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/Files.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/Files.desktop.kt
index 9042a6283..0f7c13186 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/Files.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/Files.desktop.kt
@@ -21,6 +21,8 @@ actual val agentDatabaseFileName: String = "simplex_v1_agent.db"
 
 actual val databaseExportDir: File = tmpDir
 
+actual val remoteHostsDir: File = File(dataDir.absolutePath + File.separator + "remote_hosts")
+
 actual fun desktopOpenDatabaseDir() {
   if (Desktop.isDesktopSupported()) {
     try {
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/CIImageView.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/CIImageView.desktop.kt
index 711e09267..6da207856 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/CIImageView.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/CIImageView.desktop.kt
@@ -2,12 +2,10 @@ package chat.simplex.common.views.chat.item
 
 import androidx.compose.runtime.Composable
 import androidx.compose.ui.graphics.*
-import androidx.compose.ui.graphics.painter.BitmapPainter
 import androidx.compose.ui.graphics.painter.Painter
 import chat.simplex.common.model.CIFile
 import chat.simplex.common.platform.*
 import chat.simplex.common.views.helpers.ModalManager
-import java.net.URI
 
 @Composable
 actual fun SimpleAndAnimatedImageView(
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.desktop.kt
index f602dd577..91efdf790 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.desktop.kt
@@ -34,35 +34,51 @@ actual fun ReactionIcon(text: String, fontSize: TextUnit) {
 @Composable
 actual fun SaveContentItemAction(cItem: ChatItem, saveFileLauncher: FileChooserLauncher, showMenu: MutableState<Boolean>) {
   ItemAction(stringResource(MR.strings.save_verb), painterResource(if (cItem.file?.fileSource?.cryptoArgs == null) MR.images.ic_download else MR.images.ic_lock_open_right), onClick = {
-    when (cItem.content.msgContent) {
-      is MsgContent.MCImage, is MsgContent.MCFile, is MsgContent.MCVoice, is MsgContent.MCVideo -> withApi { saveFileLauncher.launch(cItem.file?.fileName ?: "") }
-      else -> {}
+    val saveIfExists = {
+      when (cItem.content.msgContent) {
+        is MsgContent.MCImage, is MsgContent.MCFile, is MsgContent.MCVoice, is MsgContent.MCVideo -> withApi { saveFileLauncher.launch(cItem.file?.fileName ?: "") }
+        else -> {}
+      }
+      showMenu.value = false
     }
-    showMenu.value = false
+    var fileSource = getLoadedFileSource(cItem.file)
+    if (chatModel.connectedToRemote() && fileSource == null) {
+      withBGApi {
+        cItem.file?.loadRemoteFile(true)
+        fileSource = getLoadedFileSource(cItem.file)
+        saveIfExists()
+      }
+    } else saveIfExists()
   })
 }
 
-actual fun copyItemToClipboard(cItem: ChatItem, clipboard: ClipboardManager) {
-  val fileSource = getLoadedFileSource(cItem.file)
+actual fun copyItemToClipboard(cItem: ChatItem, clipboard: ClipboardManager) = withBGApi {
+  var fileSource = getLoadedFileSource(cItem.file)
+  if (chatModel.connectedToRemote() && fileSource == null) {
+    cItem.file?.loadRemoteFile(true)
+    fileSource = getLoadedFileSource(cItem.file)
+  }
+
   if (fileSource != null) {
     val filePath: String = if (fileSource.cryptoArgs != null) {
       val tmpFile = File(tmpDir, fileSource.filePath)
       tmpFile.deleteOnExit()
       try {
-        decryptCryptoFile(getAppFilePath(fileSource.filePath), fileSource.cryptoArgs, tmpFile.absolutePath)
+        decryptCryptoFile(getAppFilePath(fileSource.filePath), fileSource.cryptoArgs ?: return@withBGApi, tmpFile.absolutePath)
       } catch (e: Exception) {
         Log.e(TAG, "Unable to decrypt crypto file: " + e.stackTraceToString())
-        return
+        return@withBGApi
       }
       tmpFile.absolutePath
     } else {
       getAppFilePath(fileSource.filePath)
     }
-    when  {
+    when {
       desktopPlatform.isWindows() -> clipboard.setText(AnnotatedString("\"${File(filePath).absolutePath}\""))
       else -> clipboard.setText(AnnotatedString(filePath))
     }
   } else {
     clipboard.setText(AnnotatedString(cItem.content.text))
   }
-}
+  showToast(MR.strings.copied.localized())
+}.run {}
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/helpers/Utils.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/helpers/Utils.desktop.kt
index 7478e22a4..9413cbb40 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/helpers/Utils.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/helpers/Utils.desktop.kt
@@ -5,8 +5,7 @@ import androidx.compose.ui.text.*
 import androidx.compose.ui.text.font.FontStyle
 import androidx.compose.ui.text.font.FontWeight
 import androidx.compose.ui.unit.Density
-import chat.simplex.common.model.CIFile
-import chat.simplex.common.model.readCryptoFile
+import chat.simplex.common.model.*
 import chat.simplex.common.platform.*
 import chat.simplex.common.simplexWindowState
 import chat.simplex.res.MR
@@ -88,11 +87,21 @@ actual fun escapedHtmlToAnnotatedString(text: String, density: Density): Annotat
   AnnotatedString(text)
 }
 
-actual fun getAppFileUri(fileName: String): URI =
-  URI(appFilesDir.toURI().toString() + "/" + fileName)
+actual fun getAppFileUri(fileName: String): URI {
+  val rh = chatModel.currentRemoteHost.value
+  return if (rh == null) {
+    URI(appFilesDir.toURI().toString() + "/" + fileName)
+  } else {
+    URI(dataDir.absolutePath + "/remote_hosts/" + rh.storePath + "/simplex_v1_files/" + fileName)
+  }
+}
 
-actual fun getLoadedImage(file: CIFile?): Pair<ImageBitmap, ByteArray>? {
-  val filePath = getLoadedFilePath(file)
+actual suspend fun getLoadedImage(file: CIFile?): Pair<ImageBitmap, ByteArray>? {
+  var filePath = getLoadedFilePath(file)
+  if (chatModel.connectedToRemote() && filePath == null) {
+    file?.loadRemoteFile(false)
+    filePath = getLoadedFilePath(file)
+  }
   return if (filePath != null) {
     try {
       val data = if (file?.fileSource?.cryptoArgs != null) readCryptoFile(filePath, file.fileSource.cryptoArgs) else File(filePath).readBytes()
@@ -141,7 +150,7 @@ actual suspend fun saveTempImageUncompressed(image: ImageBitmap, asPng: Boolean)
   return if (file != null) {
     try {
       val ext = if (asPng) "png" else "jpg"
-      val newFile = File(file.absolutePath + File.separator + generateNewFileName("IMG", ext))
+      val newFile = File(file.absolutePath + File.separator + generateNewFileName("IMG", ext, File(getAppFilePath(""))))
       // LALAL FILE IS EMPTY
       ImageIO.write(image.toAwtImage(), ext.uppercase(), newFile.outputStream())
       newFile

From 96e000e3ea3da2792ad688149e9a58a07436aed5 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 18 Nov 2023 20:28:55 +0000
Subject: [PATCH 60/69] ios: add user-defined device name for remote desktop
 connection

---
 apps/ios/SimpleX (iOS).entitlements | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/apps/ios/SimpleX (iOS).entitlements b/apps/ios/SimpleX (iOS).entitlements
index 80e4adf2c..c78a7cb94 100644
--- a/apps/ios/SimpleX (iOS).entitlements	
+++ b/apps/ios/SimpleX (iOS).entitlements	
@@ -19,6 +19,8 @@
 		<string>$(AppIdentifierPrefix)chat.simplex.app</string>
 	</array>
 	<key>com.apple.developer.networking.multicast</key>
-  	<true/>
+	<true/>
+	<key>com.apple.developer.device-information.user-assigned-device-name</key>
+	<true/>
 </dict>
 </plist>

From f9e5a56e1a363bbd42611c943373eb0feba115ea Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 18 Nov 2023 22:20:22 +0000
Subject: [PATCH 61/69] ios: terminate session on network failure, add
 description for local network access

---
 apps/ios/Shared/Model/SimpleXAPI.swift     | 4 +++-
 apps/ios/SimpleX.xcodeproj/project.pbxproj | 2 ++
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift
index f1aba9126..9e4cc7cd0 100644
--- a/apps/ios/Shared/Model/SimpleXAPI.swift
+++ b/apps/ios/Shared/Model/SimpleXAPI.swift
@@ -1729,7 +1729,9 @@ func processReceivedMsg(_ res: ChatResponse) async {
             m.remoteCtrlSession = m.remoteCtrlSession?.updateState(state)
         }
     case .remoteCtrlStopped:
-        await MainActor.run {
+        // This delay is needed to cancel the session that fails on network failure,
+        // e.g. when user did not grant permission to access local network yet.
+        DispatchQueue.main.asyncAfter(deadline: .now() + 0.1) {
             switchToLocalSession()
         }
     default:
diff --git a/apps/ios/SimpleX.xcodeproj/project.pbxproj b/apps/ios/SimpleX.xcodeproj/project.pbxproj
index 62db4e43e..e98704d30 100644
--- a/apps/ios/SimpleX.xcodeproj/project.pbxproj
+++ b/apps/ios/SimpleX.xcodeproj/project.pbxproj
@@ -1502,6 +1502,7 @@
 				INFOPLIST_FILE = "SimpleX--iOS--Info.plist";
 				INFOPLIST_KEY_NSCameraUsageDescription = "SimpleX needs camera access to scan QR codes to connect to other users and for video calls.";
 				INFOPLIST_KEY_NSFaceIDUsageDescription = "SimpleX uses Face ID for local authentication";
+				INFOPLIST_KEY_NSLocalNetworkUsageDescription = "SimpleX uses local network access to allow using user chat profile via desktop app on the same network.";
 				INFOPLIST_KEY_NSMicrophoneUsageDescription = "SimpleX needs microphone access for audio and video calls, and to record voice messages.";
 				INFOPLIST_KEY_NSPhotoLibraryAddUsageDescription = "SimpleX needs access to Photo Library for saving captured and received media";
 				INFOPLIST_KEY_UIApplicationSceneManifest_Generation = YES;
@@ -1544,6 +1545,7 @@
 				INFOPLIST_FILE = "SimpleX--iOS--Info.plist";
 				INFOPLIST_KEY_NSCameraUsageDescription = "SimpleX needs camera access to scan QR codes to connect to other users and for video calls.";
 				INFOPLIST_KEY_NSFaceIDUsageDescription = "SimpleX uses Face ID for local authentication";
+				INFOPLIST_KEY_NSLocalNetworkUsageDescription = "SimpleX uses local network access to allow using user chat profile via desktop app on the same network.";
 				INFOPLIST_KEY_NSMicrophoneUsageDescription = "SimpleX needs microphone access for audio and video calls, and to record voice messages.";
 				INFOPLIST_KEY_NSPhotoLibraryAddUsageDescription = "SimpleX needs access to Photo Library for saving captured and received media";
 				INFOPLIST_KEY_UIApplicationSceneManifest_Generation = YES;

From 8f0538e756b399bc3f8b063c62d82ca926f0bd3b Mon Sep 17 00:00:00 2001
From: Stanislav Dmitrenko <7953703+avently@users.noreply.github.com>
Date: Sun, 19 Nov 2023 09:07:42 +0800
Subject: [PATCH 62/69] android: UI for remote connections (#3395)

* android: UI for remote connections

* camera permissions

* eol

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 .../common/platform/AppCommon.android.kt      |   2 +
 .../common/platform/RecAndPlay.android.kt     |   2 +-
 .../common/views/chat/ScanCodeView.android.kt |  16 -
 .../common/views/helpers/Utils.android.kt     |   2 +-
 .../views/newchat/QRCodeScanner.android.kt    |   6 +
 .../chat/simplex/common/model/ChatModel.kt    |  27 +-
 .../chat/simplex/common/model/SimpleXAPI.kt   | 116 ++++-
 .../chat/simplex/common/platform/AppCommon.kt |   2 +
 .../simplex/common/views/chat/ScanCodeView.kt |   5 +-
 .../common/views/chatlist/UserPicker.kt       |  21 +
 .../simplex/common/views/helpers/Utils.kt     |   8 +
 .../common/views/remote/ConnectDesktopView.kt | 472 ++++++++++++++++++
 .../common/views/remote/ConnectMobileView.kt  |   2 +-
 .../common/views/usersettings/SettingsView.kt |   3 +
 .../commonMain/resources/MR/base/strings.xml  |  26 +
 .../common/platform/AppCommon.desktop.kt      |   4 +
 .../common/views/chat/ScanCodeView.desktop.kt |   8 -
 17 files changed, 669 insertions(+), 53 deletions(-)
 delete mode 100644 apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.android.kt
 create mode 100644 apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectDesktopView.kt
 delete mode 100644 apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.desktop.kt

diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/AppCommon.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/AppCommon.android.kt
index 192f3dcc2..90b18bde9 100644
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/AppCommon.android.kt
+++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/AppCommon.android.kt
@@ -16,6 +16,8 @@ import kotlin.random.Random
 
 actual val appPlatform = AppPlatform.ANDROID
 
+actual val deviceName = android.os.Build.MODEL
+
 var isAppOnForeground: Boolean = false
 
 @Suppress("ConstantLocale")
diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/RecAndPlay.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/RecAndPlay.android.kt
index f99dea77c..5b0d3c778 100644
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/RecAndPlay.android.kt
+++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/RecAndPlay.android.kt
@@ -38,7 +38,7 @@ actual class RecorderNative: RecorderInterface {
     rec.setAudioSamplingRate(16000)
     rec.setAudioEncodingBitRate(32000)
     rec.setMaxDuration(MAX_VOICE_MILLIS_FOR_SENDING)
-    val fileToSave = File.createTempFile(generateNewFileName("voice", "${RecorderInterface.extension}_"), ".tmp", tmpDir)
+    val fileToSave = File.createTempFile(generateNewFileName("voice", "${RecorderInterface.extension}_", tmpDir), ".tmp", tmpDir)
     fileToSave.deleteOnExit()
     val path = fileToSave.absolutePath
     filePath = path
diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.android.kt
deleted file mode 100644
index 79361dc07..000000000
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.android.kt
+++ /dev/null
@@ -1,16 +0,0 @@
-package chat.simplex.common.views.chat
-
-import android.Manifest
-import androidx.compose.runtime.Composable
-import androidx.compose.runtime.LaunchedEffect
-import chat.simplex.common.views.chat.ScanCodeLayout
-import com.google.accompanist.permissions.rememberPermissionState
-
-@Composable
-actual fun ScanCodeView(verifyCode: (String?, cb: (Boolean) -> Unit) -> Unit, close: () -> Unit) {
-  val cameraPermissionState = rememberPermissionState(permission = Manifest.permission.CAMERA)
-  LaunchedEffect(Unit) {
-    cameraPermissionState.launchPermissionRequest()
-  }
-  ScanCodeLayout(verifyCode, close)
-}
diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/helpers/Utils.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/helpers/Utils.android.kt
index 5c7273ecc..d24429476 100644
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/helpers/Utils.android.kt
+++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/helpers/Utils.android.kt
@@ -295,7 +295,7 @@ actual suspend fun saveTempImageUncompressed(image: ImageBitmap, asPng: Boolean)
   return try {
     val ext = if (asPng) "png" else "jpg"
     tmpDir.mkdir()
-    return File(tmpDir.absolutePath + File.separator + generateNewFileName("IMG", ext)).apply {
+    return File(tmpDir.absolutePath + File.separator + generateNewFileName("IMG", ext, tmpDir)).apply {
       outputStream().use { out ->
         image.asAndroidBitmap().compress(if (asPng) Bitmap.CompressFormat.PNG else Bitmap.CompressFormat.JPEG, 85, out)
         out.flush()
diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/QRCodeScanner.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/QRCodeScanner.android.kt
index 7fb6445d5..e7453ce20 100644
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/QRCodeScanner.android.kt
+++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/QRCodeScanner.android.kt
@@ -1,5 +1,6 @@
 package chat.simplex.common.views.newchat
 
+import android.Manifest
 import android.annotation.SuppressLint
 import android.util.Log
 import android.view.ViewGroup
@@ -19,6 +20,7 @@ import boofcv.android.ConvertCameraImage
 import boofcv.factory.fiducial.FactoryFiducial
 import boofcv.struct.image.GrayU8
 import chat.simplex.common.platform.TAG
+import com.google.accompanist.permissions.rememberPermissionState
 import com.google.common.util.concurrent.ListenableFuture
 import java.util.concurrent.*
 
@@ -26,6 +28,10 @@ import java.util.concurrent.*
 
 @Composable
 actual fun QRCodeScanner(onBarcode: (String) -> Unit) {
+  val cameraPermissionState = rememberPermissionState(permission = Manifest.permission.CAMERA)
+  LaunchedEffect(Unit) {
+    cameraPermissionState.launchPermissionRequest()
+  }
   val context = LocalContext.current
   val lifecycleOwner = LocalLifecycleOwner.current
   var preview by remember { mutableStateOf<Preview?>(null) }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
index 86e507230..af946be3c 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
@@ -27,6 +27,7 @@ import kotlinx.serialization.encoding.Encoder
 import kotlinx.serialization.json.*
 import java.io.File
 import java.net.URI
+import java.net.URLDecoder
 import java.time.format.DateTimeFormatter
 import java.time.format.FormatStyle
 import java.util.*
@@ -111,6 +112,7 @@ object ChatModel {
   val remoteHosts = mutableStateListOf<RemoteHostInfo>()
   val currentRemoteHost = mutableStateOf<RemoteHostInfo?>(null)
   val newRemoteHostPairing = mutableStateOf<Pair<RemoteHostInfo?, RemoteHostSessionState>?>(null)
+  val remoteCtrlSession = mutableStateOf<RemoteCtrlSession?>(null)
 
   fun getUser(userId: Long): User? = if (currentUser.value?.userId == userId) {
     currentUser.value
@@ -598,7 +600,7 @@ object ChatModel {
     terminalItems.add(item)
   }
 
-  fun connectedToRemote(): Boolean = currentRemoteHost.value != null
+  fun connectedToRemote(): Boolean = currentRemoteHost.value != null || remoteCtrlSession.value?.active == true
 }
 
 enum class ChatType(val type: String) {
@@ -2347,7 +2349,7 @@ data class CryptoFile(
   companion object {
     fun plain(f: String): CryptoFile = CryptoFile(f, null)
 
-    fun desktopPlain(f: URI): CryptoFile = CryptoFile(f.rawPath, null)
+    fun desktopPlain(f: URI): CryptoFile = CryptoFile(URLDecoder.decode(f.rawPath, "UTF-8"), null)
   }
 }
 
@@ -2907,8 +2909,18 @@ enum class NotificationPreviewMode {
 data class RemoteCtrlSession(
   val ctrlAppInfo: CtrlAppInfo,
   val appVersion: String,
-  val sessionState: RemoteCtrlSessionState
-)
+  val sessionState: UIRemoteCtrlSessionState
+) {
+  val active: Boolean
+    get () = sessionState is UIRemoteCtrlSessionState.Connected
+
+  val sessionCode: String?
+    get() = when (val s = sessionState) {
+      is UIRemoteCtrlSessionState.PendingConfirmation -> s.sessionCode
+      is UIRemoteCtrlSessionState.Connected -> s.sessionCode
+      else -> null
+    }
+}
 
 @Serializable
 sealed class RemoteCtrlSessionState {
@@ -2917,3 +2929,10 @@ sealed class RemoteCtrlSessionState {
   @Serializable @SerialName("pendingConfirmation") data class PendingConfirmation(val sessionCode: String): RemoteCtrlSessionState()
   @Serializable @SerialName("connected") data class Connected(val sessionCode: String): RemoteCtrlSessionState()
 }
+
+sealed class UIRemoteCtrlSessionState {
+  @Serializable @SerialName("starting") object Starting: UIRemoteCtrlSessionState()
+  @Serializable @SerialName("connecting") data class Connecting(val remoteCtrl_: RemoteCtrlInfo? = null): UIRemoteCtrlSessionState()
+  @Serializable @SerialName("pendingConfirmation") data class PendingConfirmation(val remoteCtrl_: RemoteCtrlInfo? = null, val sessionCode: String): UIRemoteCtrlSessionState()
+  @Serializable @SerialName("connected") data class Connected(val remoteCtrl: RemoteCtrlInfo, val sessionCode: String): UIRemoteCtrlSessionState()
+}
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
index 0d3b16fa8..253a9fb16 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
@@ -24,7 +24,6 @@ import kotlinx.serialization.*
 import kotlinx.serialization.builtins.MapSerializer
 import kotlinx.serialization.builtins.serializer
 import kotlinx.serialization.json.*
-import java.io.File
 import java.util.Date
 
 typealias ChatCtrl = Long
@@ -167,7 +166,11 @@ class AppPreferences {
   val whatsNewVersion = mkStrPreference(SHARED_PREFS_WHATS_NEW_VERSION, null)
   val lastMigratedVersionCode = mkIntPreference(SHARED_PREFS_LAST_MIGRATED_VERSION_CODE, 0)
   val customDisappearingMessageTime = mkIntPreference(SHARED_PREFS_CUSTOM_DISAPPEARING_MESSAGE_TIME, 300)
-  val deviceNameForRemoteAccess = mkStrPreference(SHARED_PREFS_DEVICE_NAME_FOR_REMOTE_ACCESS, "Desktop")
+  val deviceNameForRemoteAccess = mkStrPreference(SHARED_PREFS_DEVICE_NAME_FOR_REMOTE_ACCESS, deviceName)
+
+  val confirmRemoteSessions = mkBoolPreference(SHARED_PREFS_CONFIRM_REMOTE_SESSIONS, false)
+  val connectRemoteViaMulticast = mkBoolPreference(SHARED_PREFS_CONNECT_REMOTE_VIA_MULTICAST, false)
+  val offerRemoteMulticast = mkBoolPreference(SHARED_PREFS_OFFER_REMOTE_MULTICAST, true)
 
   private fun mkIntPreference(prefName: String, default: Int) =
     SharedPreference(
@@ -309,6 +312,9 @@ class AppPreferences {
     private const val SHARED_PREFS_LAST_MIGRATED_VERSION_CODE = "LastMigratedVersionCode"
     private const val SHARED_PREFS_CUSTOM_DISAPPEARING_MESSAGE_TIME = "CustomDisappearingMessageTime"
     private const val SHARED_PREFS_DEVICE_NAME_FOR_REMOTE_ACCESS = "DeviceNameForRemoteAccess"
+    private const val SHARED_PREFS_CONFIRM_REMOTE_SESSIONS = "ConfirmRemoteSessions"
+    private const val SHARED_PREFS_CONNECT_REMOTE_VIA_MULTICAST = "ConnectRemoteViaMulticast"
+    private const val SHARED_PREFS_OFFER_REMOTE_MULTICAST = "OfferRemoteMulticast"
   }
 }
 
@@ -1430,18 +1436,23 @@ object ChatController {
 
   suspend fun getRemoteFile(rhId: Long, file: RemoteFile): Boolean = sendCommandOkResp(CC.GetRemoteFile(rhId, file))
 
-  suspend fun connectRemoteCtrl(invitation: String): SomeRemoteCtrl? {
-    val r = sendCmd(CC.ConnectRemoteCtrl(invitation))
-    if (r is CR.RemoteCtrlConnecting) return SomeRemoteCtrl(r.remoteCtrl_, r.ctrlAppInfo, r.appVersion)
-    apiErrorAlert("connectRemoteCtrl", generalGetString(MR.strings.error_alert_title), r)
-    return null
+  suspend fun connectRemoteCtrl(desktopAddress: String): Pair<SomeRemoteCtrl?, CR.ChatCmdError?> {
+    val r = sendCmd(CC.ConnectRemoteCtrl(desktopAddress))
+    if (r is CR.RemoteCtrlConnecting) return SomeRemoteCtrl(r.remoteCtrl_, r.ctrlAppInfo, r.appVersion) to null
+    else if (r is CR.ChatCmdError) return null to r
+    else throw Exception("connectRemoteCtrl error: ${r.responseType} ${r.details}")
   }
 
   suspend fun findKnownRemoteCtrl(): Boolean = sendCommandOkResp(CC.FindKnownRemoteCtrl())
 
-  suspend fun confirmRemoteCtrl(rhId: Long): Boolean = sendCommandOkResp(CC.ConfirmRemoteCtrl(rhId))
+  suspend fun confirmRemoteCtrl(rcId: Long): Boolean = sendCommandOkResp(CC.ConfirmRemoteCtrl(rcId))
 
-  suspend fun verifyRemoteCtrlSession(sessionCode: String): Boolean = sendCommandOkResp(CC.VerifyRemoteCtrlSession(sessionCode))
+  suspend fun verifyRemoteCtrlSession(sessionCode: String): RemoteCtrlInfo? {
+    val r = sendCmd(CC.VerifyRemoteCtrlSession(sessionCode))
+    if (r is CR.RemoteCtrlConnected) return r.remoteCtrl
+    apiErrorAlert("verifyRemoteCtrlSession", generalGetString(MR.strings.error_alert_title), r)
+    return null
+  }
 
   suspend fun listRemoteCtrls(): List<RemoteCtrlInfo>? {
     val r = sendCmd(CC.ListRemoteCtrls())
@@ -1843,6 +1854,22 @@ object ChatController {
         chatModel.newRemoteHostPairing.value = null
         switchUIRemoteHost(null)
       }
+      is CR.RemoteCtrlFound -> {
+        // TODO multicast
+        Log.d(TAG, "RemoteCtrlFound: ${r.remoteCtrl}")
+      }
+      is CR.RemoteCtrlSessionCode -> {
+        val state = UIRemoteCtrlSessionState.PendingConfirmation(remoteCtrl_ = r.remoteCtrl_, sessionCode = r.sessionCode)
+        chatModel.remoteCtrlSession.value = chatModel.remoteCtrlSession.value?.copy(sessionState = state)
+      }
+      is CR.RemoteCtrlConnected -> {
+        // TODO currently it is returned in response to command, so it is redundant
+        val state = UIRemoteCtrlSessionState.Connected(remoteCtrl = r.remoteCtrl, sessionCode = chatModel.remoteCtrlSession.value?.sessionCode ?: "")
+        chatModel.remoteCtrlSession.value = chatModel.remoteCtrlSession.value?.copy(sessionState = state)
+      }
+      is CR.RemoteCtrlStopped -> {
+        switchToLocalSession()
+      }
       else ->
         Log.d(TAG , "unsupported event: ${r.responseType}")
     }
@@ -1866,6 +1893,23 @@ object ChatController {
     }
   }
 
+  fun switchToLocalSession() {
+    val m = chatModel
+    m.remoteCtrlSession.value = null
+    withBGApi {
+      val users = listUsers()
+      m.users.clear()
+      m.users.addAll(users)
+      getUserChatData()
+      val statuses = apiGetNetworkStatuses()
+      if (statuses != null) {
+        chatModel.networkStatuses.clear()
+        val ss = statuses.associate { it.agentConnId to it.networkStatus }.toMap()
+        chatModel.networkStatuses.putAll(ss)
+      }
+    }
+  }
+
   private fun activeUser(rhId: Long?, user: UserLike): Boolean =
     rhId == chatModel.currentRemoteHost.value?.remoteHostId && user.userId == chatModel.currentUser.value?.userId
 
@@ -3474,7 +3518,10 @@ data class RemoteCtrlInfo (
   val remoteCtrlId: Long,
   val ctrlDeviceName: String,
   val sessionState: RemoteCtrlSessionState?
-)
+) {
+  val deviceViewName: String
+    get() = ctrlDeviceName.ifEmpty { remoteCtrlId.toString() }
+}
 
 @Serializable
 data class RemoteHostInfo(
@@ -4558,6 +4605,7 @@ sealed class AgentErrorType {
     is SMP -> "SMP ${smpErr.string}"
     // is NTF -> "NTF ${ntfErr.string}"
     is XFTP -> "XFTP ${xftpErr.string}"
+    is RCP -> "RCP ${rcpErr.string}"
     is BROKER -> "BROKER ${brokerErr.string}"
     is AGENT -> "AGENT ${agentErr.string}"
     is INTERNAL -> "INTERNAL $internalErr"
@@ -4568,6 +4616,7 @@ sealed class AgentErrorType {
   @Serializable @SerialName("SMP") class SMP(val smpErr: SMPErrorType): AgentErrorType()
   // @Serializable @SerialName("NTF") class NTF(val ntfErr: SMPErrorType): AgentErrorType()
   @Serializable @SerialName("XFTP") class XFTP(val xftpErr: XFTPErrorType): AgentErrorType()
+  @Serializable @SerialName("XFTP") class RCP(val rcpErr: RCErrorType): AgentErrorType()
   @Serializable @SerialName("BROKER") class BROKER(val brokerAddress: String, val brokerErr: BrokerErrorType): AgentErrorType()
   @Serializable @SerialName("AGENT") class AGENT(val agentErr: SMPAgentError): AgentErrorType()
   @Serializable @SerialName("INTERNAL") class INTERNAL(val internalErr: String): AgentErrorType()
@@ -4738,6 +4787,38 @@ sealed class XFTPErrorType {
   @Serializable @SerialName("INTERNAL") object INTERNAL: XFTPErrorType()
 }
 
+@Serializable
+sealed class RCErrorType {
+  val string: String get() = when (this) {
+    is INTERNAL -> "INTERNAL $internalErr"
+    is IDENTITY -> "IDENTITY"
+    is NO_LOCAL_ADDRESS -> "NO_LOCAL_ADDRESS"
+    is TLS_START_FAILED -> "TLS_START_FAILED"
+    is EXCEPTION -> "EXCEPTION $EXCEPTION"
+    is CTRL_AUTH -> "CTRL_AUTH"
+    is CTRL_NOT_FOUND -> "CTRL_NOT_FOUND"
+    is CTRL_ERROR -> "CTRL_ERROR $ctrlErr"
+    is VERSION -> "VERSION"
+    is ENCRYPT -> "ENCRYPT"
+    is DECRYPT -> "DECRYPT"
+    is BLOCK_SIZE -> "BLOCK_SIZE"
+    is SYNTAX -> "SYNTAX $syntaxErr"
+  }
+  @Serializable @SerialName("internal") data class INTERNAL(val internalErr: String): RCErrorType()
+  @Serializable @SerialName("identity") object IDENTITY: RCErrorType()
+  @Serializable @SerialName("noLocalAddress") object NO_LOCAL_ADDRESS: RCErrorType()
+  @Serializable @SerialName("tlsStartFailed") object TLS_START_FAILED: RCErrorType()
+  @Serializable @SerialName("exception") data class EXCEPTION(val exception: String): RCErrorType()
+  @Serializable @SerialName("ctrlAuth") object CTRL_AUTH: RCErrorType()
+  @Serializable @SerialName("ctrlNotFound") object CTRL_NOT_FOUND: RCErrorType()
+  @Serializable @SerialName("ctrlError") data class CTRL_ERROR(val ctrlErr: String): RCErrorType()
+  @Serializable @SerialName("version") object VERSION: RCErrorType()
+  @Serializable @SerialName("encrypt") object ENCRYPT: RCErrorType()
+  @Serializable @SerialName("decrypt") object DECRYPT: RCErrorType()
+  @Serializable @SerialName("blockSize") object BLOCK_SIZE: RCErrorType()
+  @Serializable @SerialName("syntax") data class SYNTAX(val syntaxErr: String): RCErrorType()
+}
+
 @Serializable
 sealed class ArchiveError {
   val string: String get() = when (this) {
@@ -4772,22 +4853,21 @@ sealed class RemoteHostError {
 sealed class RemoteCtrlError {
   val string: String get() = when (this) {
     is Inactive -> "inactive"
+    is BadState -> "badState"
     is Busy -> "busy"
     is Timeout -> "timeout"
     is Disconnected -> "disconnected"
-    is ConnectionLost -> "connectionLost"
-    is CertificateExpired -> "certificateExpired"
-    is CertificateUntrusted -> "certificateUntrusted"
-    is BadFingerprint -> "badFingerprint"
+    is BadInvitation -> "badInvitation"
+    is BadVersion -> "badVersion"
   }
   @Serializable @SerialName("inactive") object Inactive: RemoteCtrlError()
+  @Serializable @SerialName("badState") object BadState: RemoteCtrlError()
   @Serializable @SerialName("busy") object Busy: RemoteCtrlError()
   @Serializable @SerialName("timeout") object Timeout: RemoteCtrlError()
   @Serializable @SerialName("disconnected") class Disconnected(val remoteCtrlId: Long, val reason: String): RemoteCtrlError()
-  @Serializable @SerialName("connectionLost") class ConnectionLost(val remoteCtrlId: Long, val reason: String): RemoteCtrlError()
-  @Serializable @SerialName("certificateExpired") class CertificateExpired(val remoteCtrlId: Long): RemoteCtrlError()
-  @Serializable @SerialName("certificateUntrusted") class CertificateUntrusted(val remoteCtrlId: Long): RemoteCtrlError()
-  @Serializable @SerialName("badFingerprint") object BadFingerprint: RemoteCtrlError()
+  @Serializable @SerialName("badInvitation") object BadInvitation: RemoteCtrlError()
+  @Serializable @SerialName("badVersion") data class BadVersion(val appVersion: String): RemoteCtrlError()
+  //@Serializable @SerialName("protocolError") data class ProtocolError(val protocolError: RemoteProtocolError): RemoteCtrlError()
 }
 
 enum class NotificationsMode() {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/AppCommon.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/AppCommon.kt
index b10a30233..7d5b1b019 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/AppCommon.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/AppCommon.kt
@@ -18,6 +18,8 @@ enum class AppPlatform {
 
 expect val appPlatform: AppPlatform
 
+expect val deviceName: String
+
 val appVersionInfo: Pair<String, Int?> = if (appPlatform == AppPlatform.ANDROID)
   BuildConfigCommon.ANDROID_VERSION_NAME to BuildConfigCommon.ANDROID_VERSION_CODE
 else
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.kt
index 91fb4a6e8..8ce39eea3 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.kt
@@ -11,10 +11,7 @@ import chat.simplex.res.MR
 import dev.icerock.moko.resources.compose.stringResource
 
 @Composable
-expect fun ScanCodeView(verifyCode: (String?, cb: (Boolean) -> Unit) -> Unit, close: () -> Unit)
-
-@Composable
-fun ScanCodeLayout(verifyCode: (String?, cb: (Boolean) -> Unit) -> Unit, close: () -> Unit) {
+fun ScanCodeView(verifyCode: (String?, cb: (Boolean) -> Unit) -> Unit, close: () -> Unit) {
   Column(
     Modifier
       .fillMaxSize()
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt
index 66cac7204..caf8ec5cb 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt
@@ -26,6 +26,7 @@ import chat.simplex.common.model.ChatModel.controller
 import chat.simplex.common.ui.theme.*
 import chat.simplex.common.views.helpers.*
 import chat.simplex.common.platform.*
+import chat.simplex.common.views.remote.ConnectDesktopView
 import chat.simplex.common.views.remote.connectMobileDevice
 import chat.simplex.res.MR
 import dev.icerock.moko.resources.compose.stringResource
@@ -42,6 +43,7 @@ fun UserPicker(
   showSettings: Boolean = true,
   showCancel: Boolean = false,
   cancelClicked: () -> Unit = {},
+  useFromDesktopClicked: () -> Unit = {},
   settingsClicked: () -> Unit = {},
 ) {
   val scope = rememberCoroutineScope()
@@ -203,6 +205,15 @@ fun UserPicker(
           Divider(Modifier.requiredHeight(1.dp))
         }
       }
+      if (appPlatform.isAndroid) {
+        UseFromDesktopPickerItem {
+          ModalManager.start.showCustomModal { close ->
+            ConnectDesktopView(close)
+          }
+          userPickerState.value = AnimatedViewState.GONE
+        }
+        Divider(Modifier.requiredHeight(1.dp))
+      }
       if (showSettings) {
         SettingsPickerItem(settingsClicked)
       }
@@ -363,6 +374,16 @@ fun LocalDeviceRow(active: Boolean) {
   }
 }
 
+@Composable
+private fun UseFromDesktopPickerItem(onClick: () -> Unit) {
+  SectionItemView(onClick, padding = PaddingValues(start = DEFAULT_PADDING + 7.dp, end = DEFAULT_PADDING), minHeight = 68.dp) {
+    val text = generalGetString(MR.strings.settings_section_title_use_from_desktop).lowercase().capitalize(Locale.current)
+    Icon(painterResource(MR.images.ic_desktop), text, Modifier.size(20.dp), tint = MaterialTheme.colors.onBackground)
+    Spacer(Modifier.width(DEFAULT_PADDING + 6.dp))
+    Text(text, color = if (isInDarkTheme()) MenuTextColorDark else Color.Black)
+  }
+}
+
 @Composable
 private fun SettingsPickerItem(onClick: () -> Unit) {
   SectionItemView(onClick, padding = PaddingValues(start = DEFAULT_PADDING + 7.dp, end = DEFAULT_PADDING), minHeight = 68.dp) {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt
index 7128d2185..4ed5ea56b 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt
@@ -52,6 +52,14 @@ fun annotatedStringResource(id: StringResource): AnnotatedString {
   }
 }
 
+@Composable
+fun annotatedStringResource(id: StringResource, vararg args: Any?): AnnotatedString {
+  val density = LocalDensity.current
+  return remember(id) {
+    escapedHtmlToAnnotatedString(id.localized().format(args), density)
+  }
+}
+
 // maximum image file size to be auto-accepted
 const val MAX_IMAGE_SIZE: Long = 261_120 // 255KB
 const val MAX_IMAGE_SIZE_AUTO_RCV: Long = MAX_IMAGE_SIZE * 2
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectDesktopView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectDesktopView.kt
new file mode 100644
index 000000000..d631836dd
--- /dev/null
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectDesktopView.kt
@@ -0,0 +1,472 @@
+package chat.simplex.common.views.remote
+
+import SectionBottomSpacer
+import SectionDividerSpaced
+import SectionItemView
+import SectionItemViewLongClickable
+import SectionSpacer
+import SectionView
+import TextIconSpaced
+import androidx.compose.foundation.layout.*
+import androidx.compose.foundation.rememberScrollState
+import androidx.compose.foundation.text.selection.SelectionContainer
+import androidx.compose.foundation.verticalScroll
+import androidx.compose.material.*
+import androidx.compose.runtime.*
+import androidx.compose.runtime.saveable.rememberSaveable
+import androidx.compose.runtime.snapshots.SnapshotStateList
+import androidx.compose.ui.Modifier
+import androidx.compose.ui.graphics.Color
+import androidx.compose.ui.platform.LocalClipboardManager
+import androidx.compose.ui.text.AnnotatedString
+import androidx.compose.ui.text.TextStyle
+import androidx.compose.ui.text.font.FontFamily
+import androidx.compose.ui.text.input.TextFieldValue
+import androidx.compose.ui.unit.dp
+import androidx.compose.ui.unit.sp
+import chat.simplex.common.model.*
+import chat.simplex.common.model.ChatController.switchToLocalSession
+import chat.simplex.common.model.ChatModel.connectedToRemote
+import chat.simplex.common.model.ChatModel.controller
+import chat.simplex.common.platform.*
+import chat.simplex.common.ui.theme.DEFAULT_PADDING
+import chat.simplex.common.ui.theme.DEFAULT_PADDING_HALF
+import chat.simplex.common.views.chat.item.ItemAction
+import chat.simplex.common.views.helpers.*
+import chat.simplex.common.views.newchat.QRCodeScanner
+import chat.simplex.common.views.usersettings.PreferenceToggle
+import chat.simplex.common.views.usersettings.SettingsActionItem
+import chat.simplex.res.MR
+import dev.icerock.moko.resources.compose.painterResource
+import dev.icerock.moko.resources.compose.stringResource
+
+@Composable
+fun ConnectDesktopView(close: () -> Unit) {
+  val deviceName = remember { controller.appPrefs.deviceNameForRemoteAccess.state }
+  val closeWithAlert = {
+    if (!connectedToRemote()) {
+      close()
+    } else {
+      showDisconnectDesktopAlert(close)
+    }
+  }
+  ModalView(close = closeWithAlert) {
+    ConnectDesktopLayout(
+      deviceName = deviceName.value!!,
+    )
+  }
+  val ntfModeService = remember { chatModel.controller.appPrefs.notificationsMode.get() == NotificationsMode.SERVICE }
+  DisposableEffect(Unit) {
+    withBGApi {
+      if (!ntfModeService) platform.androidServiceStart()
+    }
+    onDispose {
+      if (!ntfModeService) platform.androidServiceSafeStop()
+    }
+  }
+}
+
+@Composable
+private fun ConnectDesktopLayout(deviceName: String) {
+  val sessionAddress = remember { mutableStateOf("") }
+  val remoteCtrls = remember { mutableStateListOf<RemoteCtrlInfo>() }
+  val session = remember { chatModel.remoteCtrlSession }.value
+  Column(
+    Modifier.fillMaxWidth().verticalScroll(rememberScrollState()),
+  ) {
+    if (session != null) {
+      when (session.sessionState) {
+        is UIRemoteCtrlSessionState.Starting -> ConnectingDesktop(session, null)
+        is UIRemoteCtrlSessionState.Connecting -> ConnectingDesktop(session, session.sessionState.remoteCtrl_)
+        is UIRemoteCtrlSessionState.PendingConfirmation -> {
+          if (controller.appPrefs.confirmRemoteSessions.get() || session.sessionState.remoteCtrl_ == null) {
+            VerifySession(session, session.sessionState.remoteCtrl_, session.sessionCode!!, remoteCtrls)
+          } else {
+            ConnectingDesktop(session, session.sessionState.remoteCtrl_)
+            LaunchedEffect(Unit) {
+              verifyDesktopSessionCode(remoteCtrls, session.sessionCode!!)
+            }
+          }
+        }
+
+        is UIRemoteCtrlSessionState.Connected -> ActiveSession(session, session.sessionState.remoteCtrl)
+      }
+    } else {
+      ConnectDesktop(deviceName, remoteCtrls, sessionAddress)
+    }
+    SectionBottomSpacer()
+  }
+  DisposableEffect(Unit) {
+    setDeviceName(deviceName)
+    updateRemoteCtrls(remoteCtrls)
+    onDispose {
+      if (chatModel.remoteCtrlSession.value != null) {
+        disconnectDesktop()
+      }
+    }
+  }
+}
+
+@Composable
+private fun ConnectDesktop(deviceName: String, remoteCtrls: SnapshotStateList<RemoteCtrlInfo>, sessionAddress: MutableState<String>) {
+  AppBarTitle(stringResource(MR.strings.connect_to_desktop))
+  SectionView(stringResource(MR.strings.this_device_name).uppercase()) {
+    DevicesView(deviceName, remoteCtrls) {
+      if (it != "") {
+        setDeviceName(it)
+        controller.appPrefs.deviceNameForRemoteAccess.set(it)
+      }
+    }
+  }
+  SectionDividerSpaced()
+  ScanDesktopAddressView(sessionAddress)
+  if (controller.appPrefs.developerTools.get()) {
+    SectionSpacer()
+    DesktopAddressView(sessionAddress)
+  }
+}
+
+@Composable
+private fun ConnectingDesktop(session: RemoteCtrlSession, rc: RemoteCtrlInfo?) {
+  AppBarTitle(stringResource(MR.strings.connecting_to_desktop))
+  SectionView(stringResource(MR.strings.connecting_to_desktop).uppercase(), padding = PaddingValues(horizontal = DEFAULT_PADDING)) {
+    CtrlDeviceNameText(session, rc)
+    Spacer(Modifier.height(DEFAULT_PADDING_HALF))
+    CtrlDeviceVersionText(session)
+  }
+
+  if (session.sessionCode != null) {
+    SectionSpacer()
+    SectionView(stringResource(MR.strings.session_code).uppercase()) {
+      SessionCodeText(session.sessionCode!!)
+    }
+  }
+
+  SectionSpacer()
+
+  SectionView {
+    DisconnectButton(::disconnectDesktop)
+  }
+}
+
+@Composable
+private fun VerifySession(session: RemoteCtrlSession, rc: RemoteCtrlInfo?, sessCode: String, remoteCtrls: SnapshotStateList<RemoteCtrlInfo>) {
+  AppBarTitle(stringResource(MR.strings.verify_connection))
+  SectionView(stringResource(MR.strings.connected_to_desktop).uppercase(), padding = PaddingValues(horizontal = DEFAULT_PADDING)) {
+    CtrlDeviceNameText(session, rc)
+    Spacer(Modifier.height(DEFAULT_PADDING_HALF))
+    CtrlDeviceVersionText(session)
+  }
+
+  SectionSpacer()
+
+  SectionView(stringResource(MR.strings.verify_code_with_desktop).uppercase()) {
+    SessionCodeText(sessCode)
+  }
+
+  SectionSpacer()
+
+  SectionItemView({ verifyDesktopSessionCode(remoteCtrls, sessCode) }) {
+    Icon(painterResource(MR.images.ic_check), generalGetString(MR.strings.confirm_verb), tint = MaterialTheme.colors.secondary)
+    TextIconSpaced(false)
+    Text(generalGetString(MR.strings.confirm_verb))
+  }
+
+  SectionView {
+    DisconnectButton(::disconnectDesktop)
+  }
+}
+
+@Composable
+private fun CtrlDeviceNameText(session: RemoteCtrlSession, rc: RemoteCtrlInfo?) {
+  val newDesktop = annotatedStringResource(MR.strings.new_desktop)
+  val text = remember(rc) {
+    var t = AnnotatedString(rc?.deviceViewName ?: session.ctrlAppInfo.deviceName)
+    if (rc == null) {
+      t = t + AnnotatedString(" ") + newDesktop
+    }
+    t
+  }
+  Text(text)
+}
+
+@Composable
+private fun CtrlDeviceVersionText(session: RemoteCtrlSession) {
+  val thisDeviceVersion = annotatedStringResource(MR.strings.this_device_version, session.appVersion)
+  val text = remember(session) {
+    val v = AnnotatedString(session.ctrlAppInfo.appVersionRange.maxVersion)
+    var t = AnnotatedString("v$v")
+    if (v.text != session.appVersion) {
+      t = t + AnnotatedString(" ") + thisDeviceVersion
+    }
+    t
+  }
+  Text(text)
+}
+
+@Composable
+private fun ActiveSession(session: RemoteCtrlSession, rc: RemoteCtrlInfo) {
+  AppBarTitle(stringResource(MR.strings.connected_to_desktop))
+  SectionView(stringResource(MR.strings.connected_desktop).uppercase(), padding = PaddingValues(horizontal = DEFAULT_PADDING)) {
+    Text(rc.deviceViewName)
+    Spacer(Modifier.height(DEFAULT_PADDING_HALF))
+    CtrlDeviceVersionText(session)
+  }
+
+  if (session.sessionCode != null) {
+    SectionSpacer()
+    SectionView(stringResource(MR.strings.session_code).uppercase()) {
+      SessionCodeText(session.sessionCode!!)
+    }
+  }
+
+  SectionSpacer()
+
+  SectionView {
+    DisconnectButton(::disconnectDesktop)
+  }
+}
+
+@Composable
+private fun SessionCodeText(code: String) {
+  SelectionContainer {
+    Text(
+      code.substring(0, 23),
+      Modifier.padding(start = DEFAULT_PADDING, top = 5.dp, end = DEFAULT_PADDING, bottom = 10.dp),
+      style = TextStyle(fontFamily = FontFamily.Monospace, fontSize = 16.sp)
+    )
+  }
+}
+
+@Composable
+private fun DevicesView(deviceName: String, remoteCtrls: SnapshotStateList<RemoteCtrlInfo>, updateDeviceName: (String) -> Unit) {
+  DeviceNameField(deviceName) { updateDeviceName(it) }
+  if (remoteCtrls.isNotEmpty()) {
+    SectionItemView({ ModalManager.start.showModal { LinkedDesktopsView(remoteCtrls) } }) {
+      Text(generalGetString(MR.strings.linked_desktops))
+    }
+  }
+}
+
+@Composable
+private fun ScanDesktopAddressView(sessionAddress: MutableState<String>) {
+  SectionView(stringResource(MR.strings.scan_qr_code_from_desktop).uppercase()) {
+    Box(
+      Modifier
+        .fillMaxWidth()
+        .aspectRatio(ratio = 1F)
+        .padding(DEFAULT_PADDING)
+    ) {
+      QRCodeScanner { text ->
+        sessionAddress.value = text
+        processDesktopQRCode(sessionAddress, text)
+      }
+    }
+  }
+}
+
+@Composable
+private fun DesktopAddressView(sessionAddress: MutableState<String>) {
+  val clipboard = LocalClipboardManager.current
+  SectionView(stringResource(MR.strings.desktop_address).uppercase()) {
+    if (sessionAddress.value.isEmpty()) {
+      SettingsActionItem(
+        painterResource(MR.images.ic_content_paste),
+        stringResource(MR.strings.paste_desktop_address),
+        disabled = !clipboard.hasText(),
+        click = {
+          sessionAddress.value = clipboard.getText()?.text ?: ""
+        },
+      )
+    } else {
+      Row(Modifier.padding(horizontal = DEFAULT_PADDING).fillMaxWidth()) {
+        val state = remember {
+          mutableStateOf(TextFieldValue(sessionAddress.value))
+        }
+        DefaultBasicTextField(
+          Modifier.fillMaxWidth(),
+          state,
+          color = MaterialTheme.colors.secondary,
+        ) {
+          state.value = it
+        }
+        KeyChangeEffect(state.value.text) {
+          if (state.value.text.isNotEmpty()) {
+            sessionAddress.value = state.value.text
+          }
+        }
+      }
+    }
+    SettingsActionItem(
+      painterResource(MR.images.ic_wifi),
+      stringResource(MR.strings.connect_to_desktop),
+      disabled = sessionAddress.value.isEmpty(),
+      click = {
+        connectDesktopAddress(sessionAddress, sessionAddress.value)
+      },
+    )
+  }
+}
+
+@Composable
+private fun LinkedDesktopsView(remoteCtrls: SnapshotStateList<RemoteCtrlInfo>) {
+  Column(
+    Modifier.fillMaxWidth().verticalScroll(rememberScrollState()),
+  ) {
+    AppBarTitle(stringResource(MR.strings.linked_desktops))
+    SectionView(stringResource(MR.strings.desktop_devices).uppercase()) {
+      remoteCtrls.forEach { rc ->
+        val showMenu = rememberSaveable { mutableStateOf(false) }
+        SectionItemViewLongClickable(click = {}, longClick = { showMenu.value = true }) {
+          RemoteCtrl(rc)
+          DefaultDropdownMenu(showMenu) {
+            ItemAction(stringResource(MR.strings.delete_verb), painterResource(MR.images.ic_delete), color = Color.Red) {
+              unlinkDesktop(remoteCtrls, rc)
+              showMenu.value = false
+            }
+          }
+        }
+
+      }
+    }
+    SectionDividerSpaced()
+
+    SectionView(stringResource(MR.strings.linked_desktop_options).uppercase()) {
+      PreferenceToggle(stringResource(MR.strings.verify_connections), remember { controller.appPrefs.confirmRemoteSessions.state }.value) {
+        controller.appPrefs.confirmRemoteSessions.set(it)
+      }
+      PreferenceToggle(stringResource(MR.strings.discover_on_network), remember { controller.appPrefs.connectRemoteViaMulticast.state }.value && false) {
+        controller.appPrefs.confirmRemoteSessions.set(it)
+      }
+    }
+    SectionBottomSpacer()
+  }
+}
+
+@Composable
+private fun RemoteCtrl(rc: RemoteCtrlInfo) {
+  Text(rc.deviceViewName)
+}
+
+private fun setDeviceName(name: String) {
+  withBGApi {
+    controller.setLocalDeviceName(name)
+  }
+}
+
+private fun updateRemoteCtrls(remoteCtrls: SnapshotStateList<RemoteCtrlInfo>) {
+  withBGApi {
+    val res = controller.listRemoteCtrls()
+    if (res != null) {
+      remoteCtrls.clear()
+      remoteCtrls.addAll(res)
+    }
+  }
+}
+
+private fun processDesktopQRCode(sessionAddress: MutableState<String>, resp: String) {
+  connectDesktopAddress(sessionAddress, resp)
+}
+
+private fun connectDesktopAddress(sessionAddress: MutableState<String>, addr: String) {
+  withBGApi {
+    val res = controller.connectRemoteCtrl(desktopAddress = addr)
+    if (res.first != null) {
+      val (rc_, ctrlAppInfo, v) = res.first!!
+      sessionAddress.value = ""
+      chatModel.remoteCtrlSession.value = RemoteCtrlSession(
+        ctrlAppInfo = ctrlAppInfo,
+        appVersion = v,
+        sessionState = UIRemoteCtrlSessionState.Connecting(remoteCtrl_ = rc_)
+      )
+    } else {
+      val e = res.second ?: return@withBGApi
+      when {
+        e.chatError is ChatError.ChatErrorRemoteCtrl && e.chatError.remoteCtrlError is RemoteCtrlError.BadInvitation -> showBadInvitationErrorAlert()
+        e.chatError is ChatError.ChatErrorChat && e.chatError.errorType is ChatErrorType.CommandError -> showBadInvitationErrorAlert()
+        e.chatError is ChatError.ChatErrorRemoteCtrl && e.chatError.remoteCtrlError is RemoteCtrlError.BadVersion -> showBadVersionAlert(v = e.chatError.remoteCtrlError.appVersion)
+        e.chatError is ChatError.ChatErrorAgent && e.chatError.agentError is AgentErrorType.RCP && e.chatError.agentError.rcpErr is RCErrorType.VERSION -> showBadVersionAlert(v = null)
+        e.chatError is ChatError.ChatErrorAgent && e.chatError.agentError is AgentErrorType.RCP && e.chatError.agentError.rcpErr is RCErrorType.CTRL_AUTH -> showDesktopDisconnectedErrorAlert()
+        else -> {
+          val errMsg = "${e.responseType}: ${e.details}"
+          Log.e(TAG, "bad response: $errMsg")
+          AlertManager.shared.showAlertMsg(generalGetString(MR.strings.error), errMsg)
+        }
+      }
+    }
+  }
+}
+
+private fun verifyDesktopSessionCode(remoteCtrls: SnapshotStateList<RemoteCtrlInfo>, sessCode: String) {
+  withBGApi {
+    val rc = controller.verifyRemoteCtrlSession(sessCode)
+    if (rc != null) {
+      chatModel.remoteCtrlSession.value = chatModel.remoteCtrlSession.value?.copy(sessionState = UIRemoteCtrlSessionState.Connected(remoteCtrl = rc, sessionCode = sessCode))
+    }
+    updateRemoteCtrls(remoteCtrls)
+  }
+}
+
+@Composable
+private fun DisconnectButton(onClick: () -> Unit) {
+  SectionItemView(onClick) {
+    Icon(painterResource(MR.images.ic_close), generalGetString(MR.strings.disconnect_remote_host), tint = MaterialTheme.colors.secondary)
+    TextIconSpaced(false)
+    Text(generalGetString(MR.strings.disconnect_remote_host))
+  }
+}
+
+private fun disconnectDesktop(close: (() -> Unit)? = null) {
+  withBGApi {
+    controller.stopRemoteCtrl()
+    switchToLocalSession()
+    close?.invoke()
+  }
+}
+
+private fun unlinkDesktop(remoteCtrls: SnapshotStateList<RemoteCtrlInfo>, rc: RemoteCtrlInfo) {
+  withBGApi {
+    controller.deleteRemoteCtrl(rc.remoteCtrlId)
+    remoteCtrls.removeAll { it.remoteCtrlId == rc.remoteCtrlId }
+  }
+}
+
+private fun showUnlinkDesktopAlert(remoteCtrls: SnapshotStateList<RemoteCtrlInfo>, rc: RemoteCtrlInfo) {
+  AlertManager.shared.showAlertDialog(
+    title = generalGetString(MR.strings.unlink_desktop_question),
+    confirmText = generalGetString(MR.strings.unlink_desktop),
+    destructive = true,
+    onConfirm = {
+      unlinkDesktop(remoteCtrls, rc)
+    }
+  )
+}
+
+private fun showDisconnectDesktopAlert(close: (() -> Unit)?) {
+  AlertManager.shared.showAlertDialog(
+    title = generalGetString(MR.strings.disconnect_desktop_question),
+    text = generalGetString(MR.strings.only_one_device_can_work_at_the_same_time),
+    confirmText = generalGetString(MR.strings.disconnect_remote_host),
+    destructive = true,
+    onConfirm = { disconnectDesktop(close) }
+  )
+}
+
+private fun showBadInvitationErrorAlert() {
+  AlertManager.shared.showAlertMsg(
+    title = generalGetString(MR.strings.bad_desktop_address),
+  )
+}
+
+private fun showBadVersionAlert(v: String?) {
+  AlertManager.shared.showAlertMsg(
+    title = generalGetString(MR.strings.desktop_incompatible_version),
+    text = generalGetString(MR.strings.desktop_app_version_is_incompatible).format(v ?: "")
+  )
+}
+
+private fun showDesktopDisconnectedErrorAlert() {
+  AlertManager.shared.showAlertMsg(
+    title = generalGetString(MR.strings.desktop_connection_terminated),
+  )
+}
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectMobileView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectMobileView.kt
index d00b9bb67..0d90e5945 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectMobileView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectMobileView.kt
@@ -141,7 +141,7 @@ fun ConnectMobileLayout(
 }
 
 @Composable
-private fun DeviceNameField(
+fun DeviceNameField(
   initialValue: String,
   onChange: (String) -> Unit
 ) {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt
index 5fa3c4147..2d4e5c86b 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt
@@ -29,6 +29,7 @@ import chat.simplex.common.views.database.DatabaseView
 import chat.simplex.common.views.helpers.*
 import chat.simplex.common.views.onboarding.SimpleXInfo
 import chat.simplex.common.views.onboarding.WhatsNewView
+import chat.simplex.common.views.remote.ConnectDesktopView
 import chat.simplex.common.views.remote.ConnectMobileView
 import chat.simplex.res.MR
 import kotlinx.coroutines.launch
@@ -158,6 +159,8 @@ fun SettingsLayout(
         ChatPreferencesItem(showCustomModal, stopped = stopped)
         if (appPlatform.isDesktop) {
           SettingsActionItem(painterResource(MR.images.ic_smartphone), stringResource(if (remember { chatModel.remoteHosts }.isEmpty()) MR.strings.link_a_mobile else MR.strings.linked_mobiles), showModal { ConnectMobileView(it) }, disabled = stopped, extraPadding = true)
+        } else {
+          SettingsActionItem(painterResource(MR.images.ic_desktop), stringResource(MR.strings.settings_section_title_use_from_desktop), showCustomModal{ it, close -> ConnectDesktopView(close) }, disabled = stopped, extraPadding = true)
         }
       }
       SectionDividerSpaced()
diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml
index eb3b9207b..616e78651 100644
--- a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml
+++ b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml
@@ -954,6 +954,7 @@
   <string name="settings_section_title_calls">CALLS</string>
   <string name="settings_section_title_incognito">Incognito mode</string>
   <string name="settings_section_title_experimenta">EXPERIMENTAL</string>
+  <string name="settings_section_title_use_from_desktop">Use from desktop</string>
 
   <!-- DatabaseView.kt -->
   <string name="your_chat_database">Your chat database</string>
@@ -1636,6 +1637,7 @@
   <string name="verify_connection">Verify connection</string>
   <string name="verify_code_on_mobile">Verify code on mobile</string>
   <string name="this_device_name">This device name</string>
+  <string name="this_device_version"><![CDATA[<i>(this device v%s)</i>]]></string>
   <string name="connected_mobile">Connected mobile</string>
   <string name="connected_to_mobile">Connected to mobile</string>
   <string name="enter_this_device_name">Enter this device name…</string>
@@ -1644,8 +1646,32 @@
   <string name="this_device">This device</string>
   <string name="devices">Devices</string>
   <string name="new_mobile_device">New mobile device</string>
+  <string name="unlink_desktop_question">Unlink desktop?</string>
+  <string name="unlink_desktop">Unlink</string>
   <string name="disconnect_remote_host">Disconnect</string>
+  <string name="disconnect_desktop_question">Disconnect desktop?</string>
+  <string name="only_one_device_can_work_at_the_same_time">Only one device can work at the same time</string>
   <string name="open_on_mobile_and_scan_qr_code"><![CDATA[Open <i>Use from desktop</i> in mobile app and scan QR code]]></string>
+  <string name="bad_desktop_address">Bad desktop address</string>
+  <string name="desktop_incompatible_version">Incompatible version</string>
+  <string name="desktop_app_version_is_incompatible">Desktop app version %s is not compatible with this app.</string>
+  <string name="desktop_connection_terminated">Connection terminated</string>
+  <string name="session_code">Session code</string>
+  <string name="connecting_to_desktop">Connecting to desktop</string>
+  <string name="connect_to_desktop">Connect to desktop</string>
+  <string name="connected_to_desktop">Connected to desktop</string>
+  <string name="connected_desktop">Connected desktop</string>
+  <string name="verify_code_with_desktop">Verify code with desktop</string>
+  <string name="new_desktop"><![CDATA[<i>(new)</i>]]></string>
+  <string name="linked_desktops">Linked desktops</string>
+  <string name="desktop_devices">Desktop devices</string>
+  <string name="linked_desktop_options">Linked desktop options</string>
+  <string name="scan_qr_code_from_desktop">Scan QR code from desktop</string>
+  <string name="desktop_address">Desktop address</string>
+  <string name="verify_connections">Verify connections</string>
+  <string name="discover_on_network">Discover on network</string>
+  <string name="paste_desktop_address">Paste desktop address</string>
+  <string name="desktop_device">Desktop</string>
 
   <!-- Under development -->
   <string name="in_developing_title">Coming soon!</string>
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/AppCommon.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/AppCommon.desktop.kt
index 7193fbe2b..92111f162 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/AppCommon.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/AppCommon.desktop.kt
@@ -2,11 +2,15 @@ package chat.simplex.common.platform
 
 import chat.simplex.common.model.*
 import chat.simplex.common.views.call.RcvCallInvitation
+import chat.simplex.common.views.helpers.generalGetString
 import chat.simplex.common.views.helpers.withBGApi
 import java.util.*
+import chat.simplex.res.MR
 
 actual val appPlatform = AppPlatform.DESKTOP
 
+actual val deviceName = generalGetString(MR.strings.desktop_device)
+
 @Suppress("ConstantLocale")
 val defaultLocale: Locale = Locale.getDefault()
 
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.desktop.kt
deleted file mode 100644
index 7ea2ef536..000000000
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/ScanCodeView.desktop.kt
+++ /dev/null
@@ -1,8 +0,0 @@
-package chat.simplex.common.views.chat
-
-import androidx.compose.runtime.Composable
-
-@Composable
-actual fun ScanCodeView(verifyCode: (String?, cb: (Boolean) -> Unit) -> Unit, close: () -> Unit) {
-  ScanCodeLayout(verifyCode, close)
-}

From 2a8d7b8926760045ae1120fdeacfb8dc3087b87f Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 19 Nov 2023 20:48:25 +0000
Subject: [PATCH 63/69] core: add commands that will not be forwarded to
 connected mobile (#3398)

* core: add commands that will not be forwarded to connected mobile

* fail if command that must be executed locally sent to remote host
---
 src/Simplex/Chat.hs                |  4 +++-
 src/Simplex/Chat/Controller.hs     | 15 ++++++++++++++-
 src/Simplex/Chat/Terminal/Input.hs |  3 ++-
 3 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 5c8e812a2..a6d557613 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -400,7 +400,9 @@ execChatCommand rh s = do
   case parseChatCommand s of
     Left e -> pure $ chatCmdError u e
     Right cmd -> case rh of
-      Just remoteHostId | allowRemoteCommand cmd -> execRemoteCommand u remoteHostId cmd s
+      Just rhId
+        | allowRemoteCommand cmd -> execRemoteCommand u rhId cmd s
+        | otherwise -> pure $ CRChatCmdError u $ ChatErrorRemoteHost (RHId rhId) $ RHELocalCommand
       _ -> execChatCommand_ u cmd
 
 execChatCommand' :: ChatMonad' m => ChatCommand -> m ChatResponse
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index dcfa9b431..3a97d2c32 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -452,8 +452,20 @@ allowRemoteCommand = \case
   APIStopChat -> False
   APIActivateChat -> False
   APISuspendChat _ -> False
-  SetTempFolder _ -> False
   QuitChat -> False
+  SetTempFolder _ -> False
+  SetFilesFolder _ -> False
+  SetRemoteHostsFolder _ -> False
+  APISetXFTPConfig _ -> False
+  APISetEncryptLocalFiles _ -> False
+  APIExportArchive _ -> False
+  APIImportArchive _ -> False
+  ExportArchive -> False
+  APIDeleteStorage -> False
+  APIStorageEncryption _ -> False
+  APISetNetworkConfig _ -> False
+  APIGetNetworkConfig -> False
+  SetLocalDeviceName _ -> False
   ListRemoteHosts -> False
   StartRemoteHost _ -> False
   SwitchRemoteHost {} -> False
@@ -1052,6 +1064,7 @@ data RemoteHostError
   | RHETimeout
   | RHEBadState -- ^ Illegal state transition
   | RHEBadVersion {appVersion :: AppVersion}
+  | RHELocalCommand -- ^ Command not allowed for remote execution
   | RHEDisconnected {reason :: Text} -- TODO should be sent when disconnected?
   | RHEProtocolError RemoteProtocolError
   deriving (Show, Exception)
diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs
index 090f06c7b..ecf125599 100644
--- a/src/Simplex/Chat/Terminal/Input.hs
+++ b/src/Simplex/Chat/Terminal/Input.hs
@@ -56,8 +56,9 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
   rh <- readTVarIO $ currentRemoteHost cc
   let bs = encodeUtf8 $ T.pack s
       cmd = parseChatCommand bs
+      rh' = if either (const False) allowRemoteCommand cmd then rh else Nothing
   unless (isMessage cmd) $ echo s
-  r <- runReaderT (execChatCommand rh bs) cc
+  r <- runReaderT (execChatCommand rh' bs) cc
   processResp s cmd r
   printRespToTerminal ct cc False rh r
   startLiveMessage cmd r

From ba94f76a9006020d661f4938c956d841bbb2be7a Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Mon, 20 Nov 2023 11:33:43 +0200
Subject: [PATCH 64/69] core: fix remote session stuck in Starting after
 crashed rcConnect (#3399)

---
 src/Simplex/Chat/Remote.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index f1ff0cada..1af49a2da 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -133,7 +133,7 @@ startRemoteHost rh_ = do
     Nothing -> (RHNew,False,Nothing,) <$> rcNewHostPairing
   withRemoteHostSession_ rhKey $ maybe (Right ((), Just RHSessionStarting)) (\_ -> Left $ ChatErrorRemoteHost rhKey RHEBusy)
   ctrlAppInfo <- mkCtrlAppInfo
-  (invitation, rchClient, vars) <- withAgent $ \a -> rcConnectHost a pairing (J.toJSON ctrlAppInfo) multicast
+  (invitation, rchClient, vars) <- handleConnectError rhKey . withAgent $ \a -> rcConnectHost a pairing (J.toJSON ctrlAppInfo) multicast
   cmdOk <- newEmptyTMVarIO
   rhsWaitSession <- async $ do
     rhKeyVar <- newTVarIO rhKey
@@ -157,6 +157,11 @@ startRemoteHost rh_ = do
       unless (isAppCompatible appVersion ctrlAppVersionRange) $ throwError $ RHEBadVersion appVersion
       when (encoding == PEKotlin && localEncoding == PESwift) $ throwError $ RHEProtocolError RPEIncompatibleEncoding
       pure hostInfo
+    handleConnectError :: ChatMonad m => RHKey -> m a -> m a
+    handleConnectError rhKey action = action `catchChatError` \err -> do
+      logError $ "startRemoteHost.rcConnectHost crashed: " <> tshow err
+      cancelRemoteHostSession True rhKey
+      throwError err
     handleHostError :: ChatMonad m => TVar RHKey -> m () -> m ()
     handleHostError rhKeyVar action = action `catchChatError` \err -> do
       logError $ "startRemoteHost.waitForHostSession crashed: " <> tshow err

From 68cbc605be280fc51bd9c8db9c0d8ea8cfdb6d61 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Mon, 20 Nov 2023 12:19:00 +0200
Subject: [PATCH 65/69] add remote session sequence to prevent stale state
 updates (#3390)

* add remote session sequence to prevent stale state updates

* remote RHStateKey

* add StateSeq check to controller

* clean up

* simplify

* undo withRemoteXSession API change

* simplify

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 src/Simplex/Chat.hs              |   6 +-
 src/Simplex/Chat/Controller.hs   |   7 +-
 src/Simplex/Chat/Remote.hs       | 296 ++++++++++++++++++-------------
 src/Simplex/Chat/Remote/Types.hs |   2 +
 tests/RemoteTests.hs             |   4 +-
 5 files changed, 182 insertions(+), 133 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index a6d557613..049f40680 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -215,6 +215,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
   currentCalls <- atomically TM.empty
   localDeviceName <- newTVarIO "" -- TODO set in config
   multicastSubscribers <- newTMVarIO 0
+  remoteSessionSeq <- newTVarIO 0
   remoteHostSessions <- atomically TM.empty
   remoteHostsFolder <- newTVarIO Nothing
   remoteCtrlSession <- newTVarIO Nothing
@@ -250,6 +251,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
         currentCalls,
         localDeviceName,
         multicastSubscribers,
+        remoteSessionSeq,
         remoteHostSessions,
         remoteHostsFolder,
         remoteCtrlSession,
@@ -377,8 +379,8 @@ restoreCalls = do
 
 stopChatController :: forall m. MonadUnliftIO m => ChatController -> m ()
 stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags, remoteHostSessions, remoteCtrlSession} = do
-  readTVarIO remoteHostSessions >>= mapM_ (liftIO . cancelRemoteHost False)
-  atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl False)
+  readTVarIO remoteHostSessions >>= mapM_ (liftIO . cancelRemoteHost False . snd)
+  atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (liftIO . cancelRemoteCtrl False . snd)
   disconnectAgentClient smpAgent
   readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2)
   closeFiles sndFiles
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 3a97d2c32..2ccc2ca12 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -184,9 +184,10 @@ data ChatController = ChatController
     currentCalls :: TMap ContactId Call,
     localDeviceName :: TVar Text,
     multicastSubscribers :: TMVar Int,
-    remoteHostSessions :: TMap RHKey RemoteHostSession, -- All the active remote hosts
+    remoteSessionSeq :: TVar Int,
+    remoteHostSessions :: TMap RHKey (SessionSeq, RemoteHostSession), -- All the active remote hosts
     remoteHostsFolder :: TVar (Maybe FilePath), -- folder for remote hosts data
-    remoteCtrlSession :: TVar (Maybe RemoteCtrlSession), -- Supervisor process for hosted controllers
+    remoteCtrlSession :: TVar (Maybe (SessionSeq, RemoteCtrlSession)), -- Supervisor process for hosted controllers
     config :: ChatConfig,
     filesFolder :: TVar (Maybe FilePath), -- path to files folder for mobile apps,
     expireCIThreads :: TMap UserId (Maybe (Async ())),
@@ -1196,7 +1197,7 @@ toView event = do
   session <- asks remoteCtrlSession
   atomically $
     readTVar session >>= \case
-      Just RCSessionConnected {remoteOutputQ} | allowRemoteEvent event ->
+      Just (_, RCSessionConnected {remoteOutputQ}) | allowRemoteEvent event ->
         writeTBQueue remoteOutputQ event
       -- TODO potentially, it should hold some events while connecting
       _ -> writeTBQueue localQ (Nothing, Nothing, event)
diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs
index 1af49a2da..d9ef5bd64 100644
--- a/src/Simplex/Chat/Remote.hs
+++ b/src/Simplex/Chat/Remote.hs
@@ -21,7 +21,6 @@ import Control.Monad.Reader
 import Crypto.Random (getRandomBytes)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Types as JT
-import Data.Bifunctor (second)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base64.URL as B64U
 import Data.ByteString.Builder (Builder)
@@ -29,7 +28,7 @@ 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.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
@@ -96,33 +95,43 @@ discoveryTimeout = 60000000
 -- * Desktop side
 
 getRemoteHostClient :: ChatMonad m => RemoteHostId -> m RemoteHostClient
-getRemoteHostClient rhId = withRemoteHostSession rhKey $ \case
-  s@RHSessionConnected {rhClient} -> Right (rhClient, s)
-  _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
+getRemoteHostClient rhId = do
+  sessions <- asks remoteHostSessions
+  liftIOEither . atomically $ TM.lookup rhKey sessions >>= \case
+    Just (_, RHSessionConnected {rhClient}) -> pure $ Right rhClient
+    Just _ -> pure . Left $ ChatErrorRemoteHost rhKey RHEBadState
+    Nothing -> pure . Left $ ChatErrorRemoteHost rhKey RHEMissing
   where
     rhKey = RHId rhId
 
-withRemoteHostSession :: ChatMonad m => RHKey -> (RemoteHostSession -> Either ChatError (a, RemoteHostSession)) -> m a
-withRemoteHostSession rhKey state = withRemoteHostSession_ rhKey $ maybe (Left $ ChatErrorRemoteHost rhKey $ RHEMissing) ((second . second) Just . state)
-
-withRemoteHostSession_ :: ChatMonad m => RHKey -> (Maybe RemoteHostSession -> Either ChatError (a, Maybe RemoteHostSession)) -> m a
-withRemoteHostSession_ rhKey state = do
+withRemoteHostSession :: ChatMonad m => RHKey -> SessionSeq -> (RemoteHostSession -> Either ChatError (a, RemoteHostSession)) -> m a
+withRemoteHostSession rhKey sseq f = do
   sessions <- asks remoteHostSessions
-  r <- atomically $ do
-    s <- TM.lookup rhKey sessions
-    case state s of
-      Left e -> pure $ Left e
-      Right (a, s') -> Right a <$ maybe (TM.delete rhKey) (TM.insert rhKey) s' sessions
+  r <- atomically $
+    TM.lookup rhKey sessions >>= \case
+      Nothing -> pure . Left $ ChatErrorRemoteHost rhKey RHEMissing
+      Just (stateSeq, state)
+        | stateSeq /= sseq -> pure . Left $ ChatErrorRemoteHost rhKey RHEBadState
+        | otherwise -> case f state of
+            Right (r, newState) -> Right r <$ TM.insert rhKey (sseq, newState) sessions
+            Left ce -> pure $ Left ce
   liftEither r
 
-setNewRemoteHostId :: ChatMonad m => RHKey -> RemoteHostId -> m ()
-setNewRemoteHostId rhKey rhId = do
+-- | Transition session state with a 'RHNew' ID to an assigned 'RemoteHostId'
+setNewRemoteHostId :: ChatMonad m => SessionSeq -> RemoteHostId -> m ()
+setNewRemoteHostId sseq rhId = do
   sessions <- asks remoteHostSessions
-  r <- atomically $ do
-    TM.lookupDelete rhKey sessions >>= \case
-      Nothing -> pure $ Left $ ChatErrorRemoteHost rhKey RHEMissing
-      Just s -> Right () <$ TM.insert (RHId rhId) s sessions
-  liftEither r
+  liftIOEither . atomically $ do
+    TM.lookup RHNew sessions >>= \case
+      Nothing -> err RHEMissing
+      Just sess@(stateSeq, _)
+        | stateSeq /= sseq -> err RHEBadState
+        | otherwise -> do
+            TM.delete RHNew sessions
+            TM.insert (RHId rhId) sess sessions
+            pure $ Right ()
+  where
+    err = pure . Left . ChatErrorRemoteHost RHNew
 
 startRemoteHost :: ChatMonad m => Maybe (RemoteHostId, Bool) -> m (Maybe RemoteHostInfo, RCSignedInvitation)
 startRemoteHost rh_ = do
@@ -131,16 +140,16 @@ startRemoteHost rh_ = do
       rh@RemoteHost {hostPairing} <- withStore $ \db -> getRemoteHost db rhId
       pure (RHId rhId, multicast, Just $ remoteHostInfo rh $ Just RHSStarting, hostPairing) -- get from the database, start multicast if requested
     Nothing -> (RHNew,False,Nothing,) <$> rcNewHostPairing
-  withRemoteHostSession_ rhKey $ maybe (Right ((), Just RHSessionStarting)) (\_ -> Left $ ChatErrorRemoteHost rhKey RHEBusy)
+  sseq <- startRemoteHostSession rhKey
   ctrlAppInfo <- mkCtrlAppInfo
-  (invitation, rchClient, vars) <- handleConnectError rhKey . withAgent $ \a -> rcConnectHost a pairing (J.toJSON ctrlAppInfo) multicast
+  (invitation, rchClient, vars) <- handleConnectError rhKey sseq . withAgent $ \a -> rcConnectHost a pairing (J.toJSON ctrlAppInfo) multicast
   cmdOk <- newEmptyTMVarIO
   rhsWaitSession <- async $ do
     rhKeyVar <- newTVarIO rhKey
     atomically $ takeTMVar cmdOk
-    handleHostError rhKeyVar $ waitForHostSession remoteHost_ rhKey rhKeyVar vars
+    handleHostError sseq rhKeyVar $ waitForHostSession remoteHost_ rhKey sseq rhKeyVar vars
   let rhs = RHPendingSession {rhKey, rchClient, rhsWaitSession, remoteHost_}
-  withRemoteHostSession rhKey $ \case
+  withRemoteHostSession rhKey sseq $ \case
     RHSessionStarting ->
       let inv = decodeLatin1 $ strEncode invitation
        in Right ((), RHSessionConnecting inv rhs)
@@ -157,85 +166,103 @@ startRemoteHost rh_ = do
       unless (isAppCompatible appVersion ctrlAppVersionRange) $ throwError $ RHEBadVersion appVersion
       when (encoding == PEKotlin && localEncoding == PESwift) $ throwError $ RHEProtocolError RPEIncompatibleEncoding
       pure hostInfo
-    handleConnectError :: ChatMonad m => RHKey -> m a -> m a
-    handleConnectError rhKey action = action `catchChatError` \err -> do
+    handleConnectError :: ChatMonad m => RHKey -> SessionSeq -> m a -> m a
+    handleConnectError rhKey sessSeq action = action `catchChatError` \err -> do
       logError $ "startRemoteHost.rcConnectHost crashed: " <> tshow err
-      cancelRemoteHostSession True rhKey
+      cancelRemoteHostSession (Just sessSeq) rhKey
       throwError err
-    handleHostError :: ChatMonad m => TVar RHKey -> m () -> m ()
-    handleHostError rhKeyVar action = action `catchChatError` \err -> do
+    handleHostError :: ChatMonad m => SessionSeq -> TVar RHKey -> m () -> m ()
+    handleHostError sessSeq rhKeyVar action = action `catchChatError` \err -> do
       logError $ "startRemoteHost.waitForHostSession crashed: " <> tshow err
-      readTVarIO rhKeyVar >>= cancelRemoteHostSession True
-    waitForHostSession :: ChatMonad m => Maybe RemoteHostInfo -> RHKey -> TVar RHKey -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
-    waitForHostSession remoteHost_ rhKey rhKeyVar vars = do
+      readTVarIO rhKeyVar >>= cancelRemoteHostSession (Just sessSeq)
+    waitForHostSession :: ChatMonad m => Maybe RemoteHostInfo -> RHKey -> SessionSeq -> TVar RHKey -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
+    waitForHostSession remoteHost_ rhKey sseq rhKeyVar vars = do
       (sessId, tls, vars') <- timeoutThrow (ChatErrorRemoteHost rhKey RHETimeout) 60000000 $ takeRCStep vars
       let sessionCode = verificationCode sessId
-      withRemoteHostSession rhKey $ \case
-        RHSessionConnecting _inv rhs' -> Right ((), RHSessionPendingConfirmation sessionCode tls rhs') -- TODO check it's the same session?
+      withRemoteHostSession rhKey sseq $ \case
+        RHSessionConnecting _inv rhs' -> Right ((), RHSessionPendingConfirmation sessionCode tls rhs')
         _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
-      -- display confirmation code, wait for mobile to confirm
-      let rh_' = (\rh -> (rh :: RemoteHostInfo) {sessionState = Just $ RHSPendingConfirmation {sessionCode}}) <$> remoteHost_
+      let rh_' = (\rh -> (rh :: RemoteHostInfo) {sessionState = Just RHSPendingConfirmation {sessionCode}}) <$> remoteHost_
       toView $ CRRemoteHostSessionCode {remoteHost_ = rh_', sessionCode}
       (RCHostSession {sessionKeys}, rhHello, pairing') <- timeoutThrow (ChatErrorRemoteHost rhKey RHETimeout) 60000000 $ takeRCStep vars'
       hostInfo@HostAppInfo {deviceName = hostDeviceName} <-
         liftError (ChatErrorRemoteHost rhKey) $ parseHostAppInfo rhHello
-      withRemoteHostSession rhKey $ \case
-        RHSessionPendingConfirmation _ tls' rhs' -> Right ((), RHSessionConfirmed tls' rhs') -- TODO check it's the same session?
+      withRemoteHostSession rhKey sseq $ \case
+        RHSessionPendingConfirmation _ tls' rhs' -> Right ((), RHSessionConfirmed tls' rhs')
         _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
-      -- update remoteHost with updated pairing
-      rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' rh_' hostDeviceName RHSConfirmed {sessionCode}
+      rhi@RemoteHostInfo {remoteHostId, storePath} <- upsertRemoteHost pairing' rh_' hostDeviceName sseq RHSConfirmed {sessionCode}
       let rhKey' = RHId remoteHostId -- rhKey may be invalid after upserting on RHNew
       when (rhKey' /= rhKey) $ do
         atomically $ writeTVar rhKeyVar rhKey'
         toView $ CRNewRemoteHost rhi
-      disconnected <- toIO $ onDisconnected rhKey'
-      httpClient <- liftEitherError (httpError rhKey') $ attachRevHTTP2Client disconnected tls
+      -- set up HTTP transport and remote profile protocol
+      disconnected <- toIO $ onDisconnected rhKey' sseq
+      httpClient <- liftEitherError (httpError remoteHostId) $ attachRevHTTP2Client disconnected tls
       rhClient <- mkRemoteHostClient httpClient sessionKeys sessId storePath hostInfo
       pollAction <- async $ pollEvents remoteHostId rhClient
-      withRemoteHostSession rhKey' $ \case
+      withRemoteHostSession rhKey' sseq $ \case
         RHSessionConfirmed _ RHPendingSession {rchClient} -> Right ((), RHSessionConnected {rchClient, tls, rhClient, pollAction, storePath})
-        _ -> Left $ ChatErrorRemoteHost rhKey' RHEBadState
+        _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
       chatWriteVar currentRemoteHost $ Just remoteHostId -- this is required for commands to be passed to remote host
       toView $ CRRemoteHostConnected rhi {sessionState = Just RHSConnected {sessionCode}}
-    upsertRemoteHost :: ChatMonad m => RCHostPairing -> Maybe RemoteHostInfo -> Text -> RemoteHostSessionState -> m RemoteHostInfo
-    upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rhi_ hostDeviceName state = do
+    upsertRemoteHost :: ChatMonad m => RCHostPairing -> Maybe RemoteHostInfo -> Text -> SessionSeq -> RemoteHostSessionState -> m RemoteHostInfo
+    upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rhi_ hostDeviceName sseq state = do
       KnownHostPairing {hostDhPubKey = hostDhPubKey'} <- maybe (throwError . ChatError $ CEInternalError "KnownHost is known after verification") pure kh_
       case rhi_ of
         Nothing -> do
           storePath <- liftIO randomStorePath
           rh@RemoteHost {remoteHostId} <- withStore $ \db -> insertRemoteHost db hostDeviceName storePath pairing' >>= getRemoteHost db
-          setNewRemoteHostId RHNew remoteHostId
+          setNewRemoteHostId sseq remoteHostId
           pure $ remoteHostInfo rh $ Just state
         Just rhi@RemoteHostInfo {remoteHostId} -> do
           withStore' $ \db -> updateHostPairing db remoteHostId hostDeviceName hostDhPubKey'
           pure (rhi :: RemoteHostInfo) {sessionState = Just state}
-    onDisconnected :: ChatMonad m => RHKey -> m ()
-    onDisconnected rhKey = do
-      logDebug "HTTP2 client disconnected"
-      cancelRemoteHostSession True rhKey
+    onDisconnected :: ChatMonad m => RHKey -> SessionSeq -> m ()
+    onDisconnected rhKey sseq = do
+      logDebug $ "HTTP2 client disconnected: " <> tshow (rhKey, sseq)
+      cancelRemoteHostSession (Just sseq) rhKey
     pollEvents :: ChatMonad m => RemoteHostId -> RemoteHostClient -> m ()
     pollEvents rhId rhClient = do
       oq <- asks outputQ
       forever $ do
         r_ <- liftRH rhId $ remoteRecv rhClient 10000000
         forM r_ $ \r -> atomically $ writeTBQueue oq (Nothing, Just rhId, r)
-    httpError :: RHKey -> HTTP2ClientError -> ChatError
-    httpError rhKey = ChatErrorRemoteHost rhKey . RHEProtocolError . RPEHTTP2 . tshow
+    httpError :: RemoteHostId -> HTTP2ClientError -> ChatError
+    httpError rhId = ChatErrorRemoteHost (RHId rhId) . RHEProtocolError . RPEHTTP2 . tshow
+
+startRemoteHostSession :: ChatMonad m => RHKey -> m SessionSeq
+startRemoteHostSession rhKey = do
+  sessions <- asks remoteHostSessions
+  nextSessionSeq <- asks remoteSessionSeq
+  liftIOEither . atomically $
+    TM.lookup rhKey sessions >>= \case
+      Just _ -> pure . Left $ ChatErrorRemoteHost rhKey RHEBusy
+      Nothing -> do
+        sessionSeq <- stateTVar nextSessionSeq $ \s -> (s, s + 1)
+        Right sessionSeq <$ TM.insert rhKey (sessionSeq, RHSessionStarting) sessions
 
 closeRemoteHost :: ChatMonad m => RHKey -> m ()
 closeRemoteHost rhKey = do
   logNote $ "Closing remote host session for " <> tshow rhKey
-  cancelRemoteHostSession False rhKey
+  cancelRemoteHostSession Nothing rhKey
 
-cancelRemoteHostSession :: ChatMonad m => Bool -> RHKey -> m ()
-cancelRemoteHostSession handlingError rhKey = handleAny (logError . tshow) $ do
-  chatModifyVar currentRemoteHost $ \cur -> if (RHId <$> cur) == Just rhKey then Nothing else cur -- only wipe the closing RH
+cancelRemoteHostSession :: ChatMonad m => Maybe SessionSeq -> RHKey -> m ()
+cancelRemoteHostSession sseq_ rhKey = do
   sessions <- asks remoteHostSessions
-  session_ <- atomically $ TM.lookupDelete rhKey sessions -- XXX: when invoked from delayed error handler this can wipe the next session instead
-  forM_ session_ $ \session -> do
+  crh <- asks currentRemoteHost
+  deregistered <- atomically $
+    TM.lookup rhKey sessions >>= \case
+      Nothing -> pure Nothing
+      Just (sessSeq, _) | maybe False (/= sessSeq) sseq_ -> pure Nothing -- ignore cancel from a ghost session handler
+      Just (_, rhs) -> do
+        TM.delete rhKey sessions
+        modifyTVar' crh $ \cur -> if (RHId <$> cur) == Just rhKey then Nothing else cur -- only wipe the closing RH
+        pure $ Just rhs
+  forM_ deregistered $ \session -> do
     liftIO $ cancelRemoteHost handlingError session `catchAny` (logError . tshow)
     when handlingError $ toView $ CRRemoteHostStopped rhId_
   where
+    handlingError = isJust sseq_
     rhId_ = case rhKey of
       RHNew -> Nothing
       RHId rhId -> Just rhId
@@ -270,7 +297,7 @@ listRemoteHosts = do
   map (rhInfo sessions) <$> withStore' getRemoteHosts
   where
     rhInfo sessions rh@RemoteHost {remoteHostId} =
-      remoteHostInfo rh (rhsSessionState <$> M.lookup (RHId remoteHostId) sessions)
+      remoteHostInfo rh $ rhsSessionState . snd <$> M.lookup (RHId remoteHostId) sessions
 
 switchRemoteHost :: ChatMonad m => Maybe RemoteHostId -> m (Maybe RemoteHostInfo)
 switchRemoteHost rhId_ = do
@@ -279,7 +306,7 @@ switchRemoteHost rhId_ = do
     rh <- withStore (`getRemoteHost` rhId)
     sessions <- chatReadVar remoteHostSessions
     case M.lookup rhKey sessions of
-      Just RHSessionConnected {tls} -> pure $ remoteHostInfo rh $ Just RHSConnected {sessionCode = tlsSessionCode tls}
+      Just (_, RHSessionConnected {tls}) -> pure $ remoteHostInfo rh $ Just RHSConnected {sessionCode = tlsSessionCode tls}
       _ -> throwError $ ChatErrorRemoteHost rhKey RHEInactive
   rhi_ <$ chatWriteVar currentRemoteHost rhId_
 
@@ -352,23 +379,23 @@ liftRH rhId = liftError (ChatErrorRemoteHost (RHId rhId) . RHEProtocolError)
 
 -- | Use provided OOB link as an annouce
 connectRemoteCtrlURI :: ChatMonad m => RCSignedInvitation -> m (Maybe RemoteCtrlInfo, CtrlAppInfo)
-connectRemoteCtrlURI signedInv = handleCtrlError "connectRemoteCtrl" $ do
+connectRemoteCtrlURI signedInv = do
   verifiedInv <- maybe (throwError $ ChatErrorRemoteCtrl RCEBadInvitation) pure $ verifySignedInvitation signedInv
-  withRemoteCtrlSession_ $ maybe (Right ((), Just RCSessionStarting)) (\_ -> Left $ ChatErrorRemoteCtrl RCEBusy)
-  connectRemoteCtrl verifiedInv
+  sseq <- startRemoteCtrlSession
+  connectRemoteCtrl verifiedInv sseq
 
 -- ** Multicast
 
 findKnownRemoteCtrl :: ChatMonad m => m ()
-findKnownRemoteCtrl = handleCtrlError "findKnownRemoteCtrl" $ do
+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)
+  sseq <- startRemoteCtrlSession
   foundCtrl <- newEmptyTMVarIO
   cmdOk <- newEmptyTMVarIO
-  action <- async $ handleCtrlError "findKnownRemoteCtrl.discover" $ do
+  action <- async $ handleCtrlError sseq "findKnownRemoteCtrl.discover" $ do
     atomically $ takeTMVar cmdOk
     (RCCtrlPairing {ctrlFingerprint}, inv) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) discoveryTimeout . withAgent $ \a -> rcDiscoverCtrl a pairings
     rc <- withStore' (`getRemoteCtrlByFingerprint` ctrlFingerprint) >>= \case
@@ -376,27 +403,42 @@ findKnownRemoteCtrl = handleCtrlError "findKnownRemoteCtrl" $ do
       Just rc  -> pure rc
     atomically $ putTMVar foundCtrl (rc, inv)
     toView CRRemoteCtrlFound {remoteCtrl = remoteCtrlInfo rc (Just RCSSearching)}
-  withRemoteCtrlSession $ \case
-    RCSessionStarting -> Right ((), RCSessionSearching {action, foundCtrl})
+  updateRemoteCtrlSession sseq $ \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
+  session <- asks remoteCtrlSession
+  (sseq, listener, found) <- liftIOEither $ atomically $ do
+    readTVar session >>= \case
+      Just (sseq, RCSessionSearching {action, foundCtrl}) -> do
+        writeTVar session $ Just (sseq, RCSessionStarting) -- drop intermediate "Searching" state so connectRemoteCtrl can proceed
+        pure $ Right (sseq, action, foundCtrl)
+      _ -> pure . Left $ ChatErrorRemoteCtrl RCEBadState
   uninterruptibleCancel listener
   (RemoteCtrl{remoteCtrlId = foundRcId}, verifiedInv) <- atomically $ takeTMVar found
   unless (rcId == foundRcId) $ throwError $ ChatErrorRemoteCtrl RCEBadController
-  connectRemoteCtrl verifiedInv >>= \case
+  connectRemoteCtrl verifiedInv sseq >>= \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
+startRemoteCtrlSession :: ChatMonad m => m SessionSeq
+startRemoteCtrlSession = do
+  session <- asks remoteCtrlSession
+  nextSessionSeq <- asks remoteSessionSeq
+  liftIOEither . atomically $
+    readTVar session >>= \case
+      Just _ -> pure . Left $ ChatErrorRemoteCtrl RCEBusy
+      Nothing -> do
+        sseq <- stateTVar nextSessionSeq $ \s -> (s, s + 1)
+        Right sseq <$ writeTVar session (Just (sseq, RCSessionStarting))
+
+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
   rc_ <- withStore' $ \db -> getRemoteCtrlByFingerprint db ca
   mapM_ (validateRemoteCtrl inv) rc_
@@ -406,8 +448,8 @@ connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app})
   cmdOk <- newEmptyTMVarIO
   rcsWaitSession <- async $ do
     atomically $ takeTMVar cmdOk
-    handleCtrlError "waitForCtrlSession" $ waitForCtrlSession rc_ ctrlDeviceName rcsClient vars
-  updateRemoteCtrlSession $ \case
+    handleCtrlError sseq "waitForCtrlSession" $ waitForCtrlSession rc_ ctrlDeviceName rcsClient vars
+  updateRemoteCtrlSession sseq $ \case
     RCSessionStarting -> Right RCSessionConnecting {remoteCtrlId_ = remoteCtrlId' <$> rc_, rcsClient, rcsWaitSession}
     _ -> Left $ ChatErrorRemoteCtrl RCEBadState
   atomically $ putTMVar cmdOk ()
@@ -419,7 +461,7 @@ connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app})
     waitForCtrlSession rc_ ctrlName rcsClient vars = do
       (uniq, tls, rcsWaitConfirmation) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout $ takeRCStep vars
       let sessionCode = verificationCode uniq
-      updateRemoteCtrlSession $ \case
+      updateRemoteCtrlSession sseq $ \case
         RCSessionConnecting {rcsWaitSession} ->
           let remoteCtrlId_ = remoteCtrlId' <$> rc_
            in Right RCSessionPendingConfirmation {remoteCtrlId_, ctrlDeviceName = ctrlName, rcsClient, tls, sessionCode, rcsWaitSession, rcsWaitConfirmation}
@@ -529,7 +571,7 @@ handleGetFile encryption User {userId} RemoteFile {userId = commandUserId, fileI
 
 listRemoteCtrls :: ChatMonad m => m [RemoteCtrlInfo]
 listRemoteCtrls = do
-  session <- chatReadVar remoteCtrlSession
+  session <- snd <$$> chatReadVar remoteCtrlSession
   let rcId = sessionRcId =<< session
       sessState = rcsSessionState <$> session
   map (rcInfo rcId sessState) <$> withStore' getRemoteCtrls
@@ -549,24 +591,26 @@ remoteCtrlInfo RemoteCtrl {remoteCtrlId, ctrlDeviceName} sessionState =
 
 -- | 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
-  (client, ctrlName, sessionCode, vars) <-
-    getRemoteCtrlSession >>= \case
-      RCSessionPendingConfirmation {rcsClient, ctrlDeviceName = ctrlName, sessionCode, rcsWaitConfirmation} -> pure (rcsClient, ctrlName, sessionCode, rcsWaitConfirmation)
+verifyRemoteCtrlSession execChatCommand sessCode' = do
+  (sseq, client, ctrlName, sessionCode, vars) <-
+    chatReadVar remoteCtrlSession >>= \case
+      Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
+      Just (sseq, RCSessionPendingConfirmation {rcsClient, ctrlDeviceName = ctrlName, sessionCode, rcsWaitConfirmation}) -> pure (sseq, rcsClient, ctrlName, sessionCode, rcsWaitConfirmation)
       _ -> throwError $ ChatErrorRemoteCtrl RCEBadState
-  let verified = sameVerificationCode sessCode' sessionCode
-  timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout . liftIO $ confirmCtrlSession client verified -- signal verification result before crashing
-  unless verified $ throwError $ ChatErrorRemoteCtrl $ RCEProtocolError PRESessionCode
-  (rcsSession@RCCtrlSession {tls, sessionKeys}, rcCtrlPairing) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout $ takeRCStep vars
-  rc@RemoteCtrl {remoteCtrlId} <- upsertRemoteCtrl ctrlName rcCtrlPairing
-  remoteOutputQ <- asks (tbqSize . config) >>= newTBQueueIO
-  encryption <- mkCtrlRemoteCrypto sessionKeys $ tlsUniq tls
-  http2Server <- async $ attachHTTP2Server tls $ handleRemoteCommand execChatCommand encryption remoteOutputQ
-  void . forkIO $ monitor http2Server
-  withRemoteCtrlSession $ \case
-    RCSessionPendingConfirmation {} -> Right ((), RCSessionConnected {remoteCtrlId, rcsClient = client, rcsSession, tls, http2Server, remoteOutputQ})
-    _ -> Left $ ChatErrorRemoteCtrl RCEBadState
-  pure $ remoteCtrlInfo rc $ Just RCSConnected {sessionCode = tlsSessionCode tls}
+  handleCtrlError sseq "verifyRemoteCtrlSession" $ do
+    let verified = sameVerificationCode sessCode' sessionCode
+    timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout . liftIO $ confirmCtrlSession client verified -- signal verification result before crashing
+    unless verified $ throwError $ ChatErrorRemoteCtrl $ RCEProtocolError PRESessionCode
+    (rcsSession@RCCtrlSession {tls, sessionKeys}, rcCtrlPairing) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout $ takeRCStep vars
+    rc@RemoteCtrl {remoteCtrlId} <- upsertRemoteCtrl ctrlName rcCtrlPairing
+    remoteOutputQ <- asks (tbqSize . config) >>= newTBQueueIO
+    encryption <- mkCtrlRemoteCrypto sessionKeys $ tlsUniq tls
+    http2Server <- async $ attachHTTP2Server tls $ handleRemoteCommand execChatCommand encryption remoteOutputQ
+    void . forkIO $ monitor sseq http2Server
+    updateRemoteCtrlSession sseq $ \case
+      RCSessionPendingConfirmation {} -> Right RCSessionConnected {remoteCtrlId, rcsClient = client, rcsSession, tls, http2Server, remoteOutputQ}
+      _ -> Left $ ChatErrorRemoteCtrl RCEBadState
+    pure $ remoteCtrlInfo rc $ Just RCSConnected {sessionCode = tlsSessionCode tls}
   where
     upsertRemoteCtrl :: ChatMonad m => Text -> RCCtrlPairing -> m RemoteCtrl
     upsertRemoteCtrl ctrlName rcCtrlPairing = withStore $ \db -> do
@@ -577,28 +621,35 @@ verifyRemoteCtrlSession execChatCommand sessCode' = handleCtrlError "verifyRemot
           let dhPrivKey' = dhPrivKey rcCtrlPairing
           liftIO $ updateRemoteCtrl db rc ctrlName dhPrivKey'
           pure rc {ctrlDeviceName = ctrlName, ctrlPairing = ctrlPairing {dhPrivKey = dhPrivKey'}}
-    monitor :: ChatMonad m => Async () -> m ()
-    monitor server = do
+    monitor :: ChatMonad m => SessionSeq -> Async () -> m ()
+    monitor sseq server = do
       res <- waitCatch server
       logInfo $ "HTTP2 server stopped: " <> tshow res
-      cancelActiveRemoteCtrl True
+      cancelActiveRemoteCtrl (Just sseq)
 
 stopRemoteCtrl :: ChatMonad m => m ()
-stopRemoteCtrl = cancelActiveRemoteCtrl False
+stopRemoteCtrl = cancelActiveRemoteCtrl Nothing
 
-handleCtrlError :: ChatMonad m => Text -> m a -> m a
-handleCtrlError name action =
+handleCtrlError :: ChatMonad m => SessionSeq -> Text -> m a -> m a
+handleCtrlError sseq name action =
   action `catchChatError` \e -> do
     logError $ name <> " remote ctrl error: " <> tshow e
-    cancelActiveRemoteCtrl True
+    cancelActiveRemoteCtrl (Just sseq)
     throwError e
 
-cancelActiveRemoteCtrl :: ChatMonad m => Bool -> m ()
-cancelActiveRemoteCtrl handlingError = handleAny (logError . tshow) $ do
-  session_ <- withRemoteCtrlSession_ (\s -> pure (s, Nothing))
+-- | Stop session controller, unless session update key is present but stale
+cancelActiveRemoteCtrl :: ChatMonad m => Maybe SessionSeq -> m ()
+cancelActiveRemoteCtrl sseq_ = handleAny (logError . tshow) $ do
+  var <- asks remoteCtrlSession
+  session_ <- atomically $ readTVar var >>= \case
+    Nothing -> pure Nothing
+    Just (oldSeq, _) | maybe False (/= oldSeq) sseq_ -> pure Nothing
+    Just (_, s) -> Just s <$ writeTVar var Nothing
   forM_ session_ $ \session -> do
     liftIO $ cancelRemoteCtrl handlingError session
     when handlingError $ toView CRRemoteCtrlStopped
+  where
+    handlingError = isJust sseq_
 
 cancelRemoteCtrl :: Bool -> RemoteCtrlSession -> IO ()
 cancelRemoteCtrl handlingError = \case
@@ -622,31 +673,24 @@ deleteRemoteCtrl rcId = do
   -- TODO check it exists
   withStore' (`deleteRemoteCtrlRecord` rcId)
 
-getRemoteCtrlSession :: ChatMonad m => m RemoteCtrlSession
-getRemoteCtrlSession =
-  chatReadVar remoteCtrlSession >>= maybe (throwError $ ChatErrorRemoteCtrl RCEInactive) pure
-
 checkNoRemoteCtrlSession :: ChatMonad m => m ()
 checkNoRemoteCtrlSession =
   chatReadVar remoteCtrlSession >>= maybe (pure ()) (\_ -> throwError $ ChatErrorRemoteCtrl RCEBusy)
 
-withRemoteCtrlSession :: ChatMonad m => (RemoteCtrlSession -> Either ChatError (a, RemoteCtrlSession)) -> m a
-withRemoteCtrlSession state = withRemoteCtrlSession_ $ maybe (Left $ ChatErrorRemoteCtrl RCEInactive) ((second . second) Just . state)
-
--- | Atomically process controller state wrt. specific remote ctrl session
-withRemoteCtrlSession_ :: ChatMonad m => (Maybe RemoteCtrlSession -> Either ChatError (a, Maybe RemoteCtrlSession)) -> m a
-withRemoteCtrlSession_ state = do
+-- | Transition controller to a new state, unless session update key is stale
+updateRemoteCtrlSession :: ChatMonad m => SessionSeq -> (RemoteCtrlSession -> Either ChatError RemoteCtrlSession) -> m ()
+updateRemoteCtrlSession sseq state = do
   session <- asks remoteCtrlSession
-  r <-
-    atomically $ stateTVar session $ \s ->
-      case state s of
-        Left e -> (Left e, s)
-        Right (a, s') -> (Right a, s')
+  r <- atomically $ do
+    readTVar session >>= \case
+      Nothing -> pure . Left $ ChatErrorRemoteCtrl RCEInactive
+      Just (oldSeq, st)
+        | oldSeq /= sseq -> pure . Left $ ChatErrorRemoteCtrl RCEBadState
+        | otherwise -> case state st of
+            Left ce -> pure $ Left ce
+            Right st' -> Right () <$ writeTVar session (Just (sseq, st'))
   liftEither r
 
-updateRemoteCtrlSession :: ChatMonad m => (RemoteCtrlSession -> Either ChatError RemoteCtrlSession) -> m ()
-updateRemoteCtrlSession state = withRemoteCtrlSession $ fmap ((),) . state
-
 utf8String :: [Char] -> ByteString
 utf8String = encodeUtf8 . T.pack
 {-# INLINE utf8String #-}
diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs
index c56b2462b..783a083e5 100644
--- a/src/Simplex/Chat/Remote/Types.hs
+++ b/src/Simplex/Chat/Remote/Types.hs
@@ -56,6 +56,8 @@ data RemoteSignatures
       sessPubKey :: C.PublicKeyEd25519
     }
 
+type SessionSeq = Int
+
 data RHPendingSession = RHPendingSession
   { rhKey :: RHKey,
     rchClient :: RCHostClient,
diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs
index dc2f890a7..c734c94db 100644
--- a/tests/RemoteTests.hs
+++ b/tests/RemoteTests.hs
@@ -185,7 +185,7 @@ remoteStoreFileTest =
 
       rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
       desktopHostStore <- case M.lookup (RHId 1) rhs of
-        Just RHSessionConnected {storePath} -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
+        Just (_, RHSessionConnected {storePath}) -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
         _ -> fail "Host session 1 should be started"
       desktop ##> "/store remote file 1 tests/fixtures/test.pdf"
       desktop <## "file test.pdf stored on remote host 1"
@@ -311,7 +311,7 @@ remoteCLIFileTest = testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile
 
   rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
   desktopHostStore <- case M.lookup (RHId 1) rhs of
-    Just RHSessionConnected {storePath} -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
+    Just (_, RHSessionConnected {storePath}) -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
     _ -> fail "Host session 1 should be started"
 
   mobileName <- userName mobile

From 5b7de8f8c11b5bdaa0a0ff07dfb59a9bee4bcd88 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 20 Nov 2023 10:20:10 +0000
Subject: [PATCH 66/69] desktop, android: pass remote host to API from the
 loaded objects, to prevent race conditions (#3397)

* desktop, android: pass remote host explicitely to API calls

* use remote host ID in model updates

* add remote host to chat console

* add remote host to notifications functions
---
 .../java/chat/simplex/app/MainActivity.kt     |   2 +-
 .../main/java/chat/simplex/app/SimplexApp.kt  |   2 +-
 .../common/views/call/CallView.android.kt     |  11 +-
 .../newchat/ConnectViaLinkView.android.kt     |   7 +-
 .../newchat/ScanToConnectView.android.kt      |   3 +-
 .../ScanProtocolServer.android.kt             |   4 +-
 .../kotlin/chat/simplex/common/App.kt         |   2 +-
 .../chat/simplex/common/model/ChatModel.kt    | 116 ++--
 .../chat/simplex/common/model/SimpleXAPI.kt   | 622 +++++++++---------
 .../chat/simplex/common/platform/Core.kt      |   2 +-
 .../simplex/common/platform/NtfManager.kt     |  11 +-
 .../chat/simplex/common/views/TerminalView.kt |  11 +-
 .../chat/simplex/common/views/WelcomeView.kt  |   9 +-
 .../simplex/common/views/call/CallManager.kt  |   5 +-
 .../chat/simplex/common/views/call/WebRTC.kt  |  10 +-
 .../simplex/common/views/chat/ChatInfoView.kt |  60 +-
 .../simplex/common/views/chat/ChatView.kt     |  94 +--
 .../simplex/common/views/chat/ComposeView.kt  |  27 +-
 .../common/views/chat/ContactPreferences.kt   |   5 +-
 .../views/chat/group/AddGroupMembersView.kt   |   8 +-
 .../views/chat/group/GroupChatInfoView.kt     |  55 +-
 .../common/views/chat/group/GroupLinkView.kt  |   7 +-
 .../views/chat/group/GroupMemberInfoView.kt   |  68 +-
 .../views/chat/group/GroupPreferences.kt      |  12 +-
 .../views/chat/group/GroupProfileView.kt      |   6 +-
 .../views/chat/group/WelcomeMessageView.kt    |   6 +-
 .../views/chatlist/ChatListNavLinkView.kt     | 157 ++---
 .../common/views/chatlist/ChatListView.kt     |   9 +-
 .../views/chatlist/ShareListNavLinkView.kt    |   4 +-
 .../common/views/chatlist/UserPicker.kt       |   4 +-
 .../common/views/database/DatabaseView.kt     |  18 +-
 .../simplex/common/views/helpers/Utils.kt     |   2 +-
 .../common/views/localauth/LocalAuthView.kt   |   2 +-
 .../common/views/newchat/AddContactView.kt    |   8 +-
 .../common/views/newchat/AddGroupView.kt      |  12 +-
 .../views/newchat/ConnectViaLinkView.kt       |   2 +-
 .../newchat/ContactConnectionInfoView.kt      |  11 +-
 .../common/views/newchat/CreateLinkView.kt    |  11 +-
 .../common/views/newchat/NewChatSheet.kt      |   9 +-
 .../common/views/newchat/PasteToConnect.kt    |   7 +-
 .../common/views/newchat/ScanToConnectView.kt |  82 +--
 .../views/onboarding/CreateSimpleXAddress.kt  |  16 +-
 .../onboarding/SetupDatabasePassphrase.kt     |   2 +-
 .../views/usersettings/HiddenProfileView.kt   |   2 +-
 .../views/usersettings/NetworkAndServers.kt   |   4 +-
 .../common/views/usersettings/Preferences.kt  |   6 +-
 .../views/usersettings/PrivacySettings.kt     |   8 +-
 .../views/usersettings/ProtocolServerView.kt  |   2 +-
 .../views/usersettings/ProtocolServersView.kt |  21 +-
 .../views/usersettings/ScanProtocolServer.kt  |   6 +-
 .../usersettings/SetDeliveryReceiptsView.kt   |   4 +-
 .../common/views/usersettings/SettingsView.kt |   2 +-
 .../views/usersettings/UserAddressView.kt     |  10 +-
 .../views/usersettings/UserProfileView.kt     |   4 +-
 .../views/usersettings/UserProfilesView.kt    |  14 +-
 .../common/views/call/CallView.desktop.kt     |  11 +-
 .../views/chatlist/ChatListView.desktop.kt    |   2 +-
 .../newchat/ConnectViaLinkView.desktop.kt     |   5 +-
 .../newchat/ScanToConnectView.desktop.kt      |   3 +-
 .../ScanProtocolServer.desktop.kt             |   4 +-
 60 files changed, 853 insertions(+), 776 deletions(-)

diff --git a/apps/multiplatform/android/src/main/java/chat/simplex/app/MainActivity.kt b/apps/multiplatform/android/src/main/java/chat/simplex/app/MainActivity.kt
index 40c04f508..4c5d595a8 100644
--- a/apps/multiplatform/android/src/main/java/chat/simplex/app/MainActivity.kt
+++ b/apps/multiplatform/android/src/main/java/chat/simplex/app/MainActivity.kt
@@ -126,7 +126,7 @@ fun processIntent(intent: Intent?) {
   when (intent?.action) {
     "android.intent.action.VIEW" -> {
       val uri = intent.data
-      if (uri != null) connectIfOpenedViaUri(uri.toURI(), ChatModel)
+      if (uri != null) connectIfOpenedViaUri(chatModel.remoteHostId, uri.toURI(), ChatModel)
     }
   }
 }
diff --git a/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt b/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt
index d2c446517..13908f69b 100644
--- a/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt
+++ b/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt
@@ -57,7 +57,7 @@ class SimplexApp: Application(), LifecycleEventObserver {
             updatingChatsMutex.withLock {
               kotlin.runCatching {
                 val currentUserId = chatModel.currentUser.value?.userId
-                val chats = ArrayList(chatController.apiGetChats())
+                val chats = ArrayList(chatController.apiGetChats(chatModel.remoteHostId))
                 /** Active user can be changed in background while [ChatController.apiGetChats] is executing */
                 if (chatModel.currentUser.value?.userId == currentUserId) {
                   val currentChatId = chatModel.chatId.value
diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallView.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallView.android.kt
index 5c7b430ab..c173463d5 100644
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallView.android.kt
+++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallView.android.kt
@@ -115,22 +115,23 @@ actual fun ActiveCallView() {
       val call = chatModel.activeCall.value
       if (call != null) {
         Log.d(TAG, "has active call $call")
+        val callRh = call.remoteHostId
         when (val r = apiMsg.resp) {
           is WCallResponse.Capabilities -> withBGApi {
             val callType = CallType(call.localMedia, r.capabilities)
-            chatModel.controller.apiSendCallInvitation(call.contact, callType)
+            chatModel.controller.apiSendCallInvitation(callRh, call.contact, callType)
             chatModel.activeCall.value = call.copy(callState = CallState.InvitationSent, localCapabilities = r.capabilities)
           }
           is WCallResponse.Offer -> withBGApi {
-            chatModel.controller.apiSendCallOffer(call.contact, r.offer, r.iceCandidates, call.localMedia, r.capabilities)
+            chatModel.controller.apiSendCallOffer(callRh, call.contact, r.offer, r.iceCandidates, call.localMedia, r.capabilities)
             chatModel.activeCall.value = call.copy(callState = CallState.OfferSent, localCapabilities = r.capabilities)
           }
           is WCallResponse.Answer -> withBGApi {
-            chatModel.controller.apiSendCallAnswer(call.contact, r.answer, r.iceCandidates)
+            chatModel.controller.apiSendCallAnswer(callRh, call.contact, r.answer, r.iceCandidates)
             chatModel.activeCall.value = call.copy(callState = CallState.Negotiated)
           }
           is WCallResponse.Ice -> withBGApi {
-            chatModel.controller.apiSendCallExtraInfo(call.contact, r.iceCandidates)
+            chatModel.controller.apiSendCallExtraInfo(callRh, call.contact, r.iceCandidates)
           }
           is WCallResponse.Connection ->
             try {
@@ -139,7 +140,7 @@ actual fun ActiveCallView() {
                 chatModel.activeCall.value = call.copy(callState = CallState.Connected, connectedAt = Clock.System.now())
                 setCallSound(call.soundSpeaker, audioViaBluetooth)
               }
-              withBGApi { chatModel.controller.apiCallStatus(call.contact, callStatus) }
+              withBGApi { chatModel.controller.apiCallStatus(callRh, call.contact, callStatus) }
             } catch (e: Error) {
               Log.d(TAG,"call status ${r.state.connectionState} not used")
             }
diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.android.kt
index dcb505542..1faf115b3 100644
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.android.kt
+++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.android.kt
@@ -12,7 +12,8 @@ import chat.simplex.common.model.ChatModel
 import chat.simplex.res.MR
 
 @Composable
-actual fun ConnectViaLinkView(m: ChatModel, close: () -> Unit) {
+actual fun ConnectViaLinkView(m: ChatModel, rhId: Long?, close: () -> Unit) {
+  // TODO this should close if remote host changes in model
   val selection = remember {
     mutableStateOf(
       runCatching { ConnectViaLinkTab.valueOf(m.controller.appPrefs.connectViaLinkTab.get()!!) }.getOrDefault(ConnectViaLinkTab.SCAN)
@@ -31,10 +32,10 @@ actual fun ConnectViaLinkView(m: ChatModel, close: () -> Unit) {
     Column(Modifier.weight(1f)) {
       when (selection.value) {
         ConnectViaLinkTab.SCAN -> {
-          ScanToConnectView(m, close)
+          ScanToConnectView(m, rhId, close)
         }
         ConnectViaLinkTab.PASTE -> {
-          PasteToConnectView(m, close)
+          PasteToConnectView(m, rhId, close)
         }
       }
     }
diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.android.kt
index d0cad3121..89477e45a 100644
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.android.kt
+++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.android.kt
@@ -7,13 +7,14 @@ import chat.simplex.common.model.ChatModel
 import com.google.accompanist.permissions.rememberPermissionState
 
 @Composable
-actual fun ScanToConnectView(chatModel: ChatModel, close: () -> Unit) {
+actual fun ScanToConnectView(chatModel: ChatModel, rhId: Long?, close: () -> Unit) {
   val cameraPermissionState = rememberPermissionState(permission = Manifest.permission.CAMERA)
   LaunchedEffect(Unit) {
     cameraPermissionState.launchPermissionRequest()
   }
   ConnectContactLayout(
     chatModel = chatModel,
+    rhId = rhId,
     incognitoPref = chatModel.controller.appPrefs.incognito,
     close = close
   )
diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.android.kt
index a1b7b3141..af5a27be1 100644
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.android.kt
+++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.android.kt
@@ -7,10 +7,10 @@ import chat.simplex.common.model.ServerCfg
 import com.google.accompanist.permissions.rememberPermissionState
 
 @Composable
-actual fun ScanProtocolServer(onNext: (ServerCfg) -> Unit) {
+actual fun ScanProtocolServer(rhId: Long?, onNext: (ServerCfg) -> Unit) {
   val cameraPermissionState = rememberPermissionState(permission = Manifest.permission.CAMERA)
   LaunchedEffect(Unit) {
     cameraPermissionState.launchPermissionRequest()
   }
-  ScanProtocolServerLayout(onNext)
+  ScanProtocolServerLayout(rhId, onNext)
 }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/App.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/App.kt
index 41deee7a5..da74a37aa 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/App.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/App.kt
@@ -138,7 +138,7 @@ fun MainScreen() {
       }
       onboarding == OnboardingStage.Step2_CreateProfile -> CreateFirstProfile(chatModel) {}
       onboarding == OnboardingStage.Step2_5_SetupDatabasePassphrase -> SetupDatabasePassphrase(chatModel)
-      onboarding == OnboardingStage.Step3_CreateSimpleXAddress -> CreateSimpleXAddress(chatModel)
+      onboarding == OnboardingStage.Step3_CreateSimpleXAddress -> CreateSimpleXAddress(chatModel, null)
       onboarding == OnboardingStage.Step4_SetNotificationsMode -> SetNotificationsMode(chatModel)
     }
     if (appPlatform.isAndroid) {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
index af946be3c..ab8b6af3f 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
@@ -111,6 +111,7 @@ object ChatModel {
   // remote controller
   val remoteHosts = mutableStateListOf<RemoteHostInfo>()
   val currentRemoteHost = mutableStateOf<RemoteHostInfo?>(null)
+  val remoteHostId: Long? get() = currentRemoteHost?.value?.remoteHostId
   val newRemoteHostPairing = mutableStateOf<Pair<RemoteHostInfo?, RemoteHostSessionState>?>(null)
   val remoteCtrlSession = mutableStateOf<RemoteCtrlSession?>(null)
 
@@ -141,16 +142,17 @@ object ChatModel {
   }
 
   // toList() here is to prevent ConcurrentModificationException that is rarely happens but happens
-  fun hasChat(id: String): Boolean = chats.toList().firstOrNull { it.id == id } != null
+  fun hasChat(rhId: Long?, id: String): Boolean = chats.toList().firstOrNull { it.id == id && it.remoteHostId == rhId } != null
+  // TODO pass rhId?
   fun getChat(id: String): Chat? = chats.toList().firstOrNull { it.id == id }
   fun getContactChat(contactId: Long): Chat? = chats.toList().firstOrNull { it.chatInfo is ChatInfo.Direct && it.chatInfo.apiId == contactId }
   fun getGroupChat(groupId: Long): Chat? = chats.toList().firstOrNull { it.chatInfo is ChatInfo.Group && it.chatInfo.apiId == groupId }
   fun getGroupMember(groupMemberId: Long): GroupMember? = groupMembers.firstOrNull { it.groupMemberId == groupMemberId }
-  private fun getChatIndex(id: String): Int = chats.toList().indexOfFirst { it.id == id }
+  private fun getChatIndex(rhId: Long?, id: String): Int = chats.toList().indexOfFirst { it.id == id && it.remoteHostId == rhId }
   fun addChat(chat: Chat) = chats.add(index = 0, chat)
 
-  fun updateChatInfo(cInfo: ChatInfo) {
-    val i = getChatIndex(cInfo.id)
+  fun updateChatInfo(rhId: Long?, cInfo: ChatInfo) {
+    val i = getChatIndex(rhId, cInfo.id)
     if (i >= 0) {
       val currentCInfo = chats[i].chatInfo
       var newCInfo = cInfo
@@ -172,23 +174,23 @@ object ChatModel {
     }
   }
 
-  fun updateContactConnection(contactConnection: PendingContactConnection) = updateChat(ChatInfo.ContactConnection(contactConnection))
+  fun updateContactConnection(rhId: Long?, contactConnection: PendingContactConnection) = updateChat(rhId, ChatInfo.ContactConnection(contactConnection))
 
-  fun updateContact(contact: Contact) = updateChat(ChatInfo.Direct(contact), addMissing = contact.directOrUsed)
+  fun updateContact(rhId: Long?, contact: Contact) = updateChat(rhId, ChatInfo.Direct(contact), addMissing = contact.directOrUsed)
 
-  fun updateContactConnectionStats(contact: Contact, connectionStats: ConnectionStats) {
+  fun updateContactConnectionStats(rhId: Long?, contact: Contact, connectionStats: ConnectionStats) {
     val updatedConn = contact.activeConn?.copy(connectionStats = connectionStats)
     val updatedContact = contact.copy(activeConn = updatedConn)
-    updateContact(updatedContact)
+    updateContact(rhId, updatedContact)
   }
 
-  fun updateGroup(groupInfo: GroupInfo) = updateChat(ChatInfo.Group(groupInfo))
+  fun updateGroup(rhId: Long?, groupInfo: GroupInfo) = updateChat(rhId, ChatInfo.Group(groupInfo))
 
-  private fun updateChat(cInfo: ChatInfo, addMissing: Boolean = true) {
-    if (hasChat(cInfo.id)) {
-      updateChatInfo(cInfo)
+  private fun updateChat(rhId: Long?, cInfo: ChatInfo, addMissing: Boolean = true) {
+    if (hasChat(rhId, cInfo.id)) {
+      updateChatInfo(rhId, cInfo)
     } else if (addMissing) {
-      addChat(Chat(chatInfo = cInfo, chatItems = arrayListOf()))
+      addChat(Chat(remoteHostId = rhId, chatInfo = cInfo, chatItems = arrayListOf()))
     }
   }
 
@@ -203,8 +205,8 @@ object ChatModel {
     }
   }
 
-  fun replaceChat(id: String, chat: Chat) {
-    val i = getChatIndex(id)
+  fun replaceChat(rhId: Long?, id: String, chat: Chat) {
+    val i = getChatIndex(rhId, id)
     if (i >= 0) {
       chats[i] = chat
     } else {
@@ -213,9 +215,9 @@ object ChatModel {
     }
   }
 
-  suspend fun addChatItem(cInfo: ChatInfo, cItem: ChatItem) = updatingChatsMutex.withLock {
+  suspend fun addChatItem(rhId: Long?, cInfo: ChatInfo, cItem: ChatItem) = updatingChatsMutex.withLock {
     // update previews
-    val i = getChatIndex(cInfo.id)
+    val i = getChatIndex(rhId, cInfo.id)
     val chat: Chat
     if (i >= 0) {
       chat = chats[i]
@@ -224,7 +226,7 @@ object ChatModel {
         chatStats =
           if (cItem.meta.itemStatus is CIStatus.RcvNew) {
             val minUnreadId = if(chat.chatStats.minUnreadItemId == 0L) cItem.id else chat.chatStats.minUnreadItemId
-            increaseUnreadCounter(currentUser.value!!)
+            increaseUnreadCounter(rhId, currentUser.value!!)
             chat.chatStats.copy(unreadCount = chat.chatStats.unreadCount + 1, minUnreadItemId = minUnreadId)
           }
           else
@@ -234,7 +236,7 @@ object ChatModel {
         popChat_(i)
       }
     } else {
-      addChat(Chat(chatInfo = cInfo, chatItems = arrayListOf(cItem)))
+      addChat(Chat(remoteHostId = rhId, chatInfo = cInfo, chatItems = arrayListOf(cItem)))
     }
     Log.d(TAG, "TODOCHAT: addChatItem: adding to chat ${chatId.value} from ${cInfo.id} ${cItem.id}, size ${chatItems.size}")
     withContext(Dispatchers.Main) {
@@ -254,9 +256,9 @@ object ChatModel {
     }
   }
 
-  suspend fun upsertChatItem(cInfo: ChatInfo, cItem: ChatItem): Boolean  = updatingChatsMutex.withLock {
+  suspend fun upsertChatItem(rhId: Long?, cInfo: ChatInfo, cItem: ChatItem): Boolean  = updatingChatsMutex.withLock {
     // update previews
-    val i = getChatIndex(cInfo.id)
+    val i = getChatIndex(rhId, cInfo.id)
     val chat: Chat
     val res: Boolean
     if (i >= 0) {
@@ -266,12 +268,12 @@ object ChatModel {
         chats[i] = chat.copy(chatItems = arrayListOf(cItem))
         if (pItem.isRcvNew && !cItem.isRcvNew) {
           // status changed from New to Read, update counter
-          decreaseCounterInChat(cInfo.id)
+          decreaseCounterInChat(rhId, cInfo.id)
         }
       }
       res = false
     } else {
-      addChat(Chat(chatInfo = cInfo, chatItems = arrayListOf(cItem)))
+      addChat(Chat(remoteHostId = rhId, chatInfo = cInfo, chatItems = arrayListOf(cItem)))
       res = true
     }
     Log.d(TAG, "TODOCHAT: upsertChatItem: upserting to chat ${chatId.value} from ${cInfo.id} ${cItem.id}, size ${chatItems.size}")
@@ -313,12 +315,12 @@ object ChatModel {
     }
   }
 
-  fun removeChatItem(cInfo: ChatInfo, cItem: ChatItem) {
+  fun removeChatItem(rhId: Long?, cInfo: ChatInfo, cItem: ChatItem) {
     if (cItem.isRcvNew) {
-      decreaseCounterInChat(cInfo.id)
+      decreaseCounterInChat(rhId, cInfo.id)
     }
     // update previews
-    val i = getChatIndex(cInfo.id)
+    val i = getChatIndex(rhId, cInfo.id)
     val chat: Chat
     if (i >= 0) {
       chat = chats[i]
@@ -337,11 +339,11 @@ object ChatModel {
     }
   }
 
-  fun clearChat(cInfo: ChatInfo) {
+  fun clearChat(rhId: Long?, cInfo: ChatInfo) {
     // clear preview
-    val i = getChatIndex(cInfo.id)
+    val i = getChatIndex(rhId, cInfo.id)
     if (i >= 0) {
-      decreaseUnreadCounter(currentUser.value!!, chats[i].chatStats.unreadCount)
+      decreaseUnreadCounter(rhId, currentUser.value!!, chats[i].chatStats.unreadCount)
       chats[i] = chats[i].copy(chatItems = arrayListOf(), chatStats = Chat.ChatStats(), chatInfo = cInfo)
     }
     // clear current chat
@@ -351,15 +353,15 @@ object ChatModel {
     }
   }
 
-  fun updateCurrentUser(newProfile: Profile, preferences: FullChatPreferences? = null) {
+  fun updateCurrentUser(rhId: Long?, newProfile: Profile, preferences: FullChatPreferences? = null) {
     val current = currentUser.value ?: return
     val updated = current.copy(
       profile = newProfile.toLocalProfile(current.profile.profileId),
       fullPreferences = preferences ?: current.fullPreferences
     )
-    val indexInUsers = users.indexOfFirst { it.user.userId == current.userId }
-    if (indexInUsers != -1) {
-      users[indexInUsers] = UserInfo(updated, users[indexInUsers].unreadCount)
+    val i = users.indexOfFirst { it.user.userId == current.userId && it.user.remoteHostId == rhId }
+    if (i != -1) {
+      users[i] = users[i].copy(user = updated)
     }
     currentUser.value = updated
   }
@@ -378,16 +380,17 @@ object ChatModel {
     }
   }
 
-  fun markChatItemsRead(cInfo: ChatInfo, range: CC.ItemRange? = null, unreadCountAfter: Int? = null) {
-    val markedRead = markItemsReadInCurrentChat(cInfo, range)
+  fun markChatItemsRead(chat: Chat, range: CC.ItemRange? = null, unreadCountAfter: Int? = null) {
+    val cInfo = chat.chatInfo
+    val markedRead = markItemsReadInCurrentChat(chat, range)
     // update preview
-    val chatIdx = getChatIndex(cInfo.id)
+    val chatIdx = getChatIndex(chat.remoteHostId, cInfo.id)
     if (chatIdx >= 0) {
       val chat = chats[chatIdx]
       val lastId = chat.chatItems.lastOrNull()?.id
       if (lastId != null) {
         val unreadCount = unreadCountAfter ?: if (range != null) chat.chatStats.unreadCount - markedRead else 0
-        decreaseUnreadCounter(currentUser.value!!, chat.chatStats.unreadCount - unreadCount)
+        decreaseUnreadCounter(chat.remoteHostId, currentUser.value!!, chat.chatStats.unreadCount - unreadCount)
         chats[chatIdx] = chat.copy(
           chatStats = chat.chatStats.copy(
             unreadCount = unreadCount,
@@ -399,7 +402,8 @@ object ChatModel {
     }
   }
 
-  private fun markItemsReadInCurrentChat(cInfo: ChatInfo, range: CC.ItemRange? = null): Int {
+  private fun markItemsReadInCurrentChat(chat: Chat, range: CC.ItemRange? = null): Int {
+    val cInfo = chat.chatInfo
     var markedRead = 0
     if (chatId.value == cInfo.id) {
       var i = 0
@@ -423,13 +427,13 @@ object ChatModel {
     return markedRead
   }
 
-  private fun decreaseCounterInChat(chatId: ChatId) {
-    val chatIndex = getChatIndex(chatId)
+  private fun decreaseCounterInChat(rhId: Long?, chatId: ChatId) {
+    val chatIndex = getChatIndex(rhId, chatId)
     if (chatIndex == -1) return
 
     val chat = chats[chatIndex]
     val unreadCount = kotlin.math.max(chat.chatStats.unreadCount - 1, 0)
-    decreaseUnreadCounter(currentUser.value!!, chat.chatStats.unreadCount - unreadCount)
+    decreaseUnreadCounter(rhId, currentUser.value!!, chat.chatStats.unreadCount - unreadCount)
     chats[chatIndex] = chat.copy(
       chatStats = chat.chatStats.copy(
         unreadCount = unreadCount,
@@ -437,18 +441,18 @@ object ChatModel {
     )
   }
 
-  fun increaseUnreadCounter(user: UserLike) {
-    changeUnreadCounter(user, 1)
+  fun increaseUnreadCounter(rhId: Long?, user: UserLike) {
+    changeUnreadCounter(rhId, user, 1)
   }
 
-  fun decreaseUnreadCounter(user: UserLike, by: Int = 1) {
-    changeUnreadCounter(user, -by)
+  fun decreaseUnreadCounter(rhId: Long?, user: UserLike, by: Int = 1) {
+    changeUnreadCounter(rhId, user, -by)
   }
 
-  private fun changeUnreadCounter(user: UserLike, by: Int) {
-    val i = users.indexOfFirst { it.user.userId == user.userId }
+  private fun changeUnreadCounter(rhId: Long?, user: UserLike, by: Int) {
+    val i = users.indexOfFirst { it.user.userId == user.userId && it.user.remoteHostId == rhId }
     if (i != -1) {
-      users[i] = UserInfo(users[i].user, users[i].unreadCount + by)
+      users[i] = users[i].copy(unreadCount = users[i].unreadCount + by)
     }
   }
 
@@ -544,14 +548,14 @@ object ChatModel {
     }
   }
 
-  fun removeChat(id: String) {
-    chats.removeAll { it.id == id }
+  fun removeChat(rhId: Long?, id: String) {
+    chats.removeAll { it.id == id && it.remoteHostId == rhId }
   }
 
-  fun upsertGroupMember(groupInfo: GroupInfo, member: GroupMember): Boolean {
+  fun upsertGroupMember(rhId: Long?, groupInfo: GroupInfo, member: GroupMember): Boolean {
     // user member was updated
     if (groupInfo.membership.groupMemberId == member.groupMemberId) {
-      updateGroup(groupInfo)
+      updateGroup(rhId, groupInfo)
       return false
     }
     // update current chat
@@ -569,12 +573,12 @@ object ChatModel {
     }
   }
 
-  fun updateGroupMemberConnectionStats(groupInfo: GroupInfo, member: GroupMember, connectionStats: ConnectionStats) {
+  fun updateGroupMemberConnectionStats(rhId: Long?, groupInfo: GroupInfo, member: GroupMember, connectionStats: ConnectionStats) {
     val memberConn = member.activeConn
     if (memberConn != null) {
       val updatedConn = memberConn.copy(connectionStats = connectionStats)
       val updatedMember = member.copy(activeConn = updatedConn)
-      upsertGroupMember(groupInfo, updatedMember)
+      upsertGroupMember(rhId, groupInfo, updatedMember)
     }
   }
 
@@ -612,6 +616,7 @@ enum class ChatType(val type: String) {
 
 @Serializable
 data class User(
+  val remoteHostId: Long? = null,
   override val userId: Long,
   val userContactId: Long,
   val localDisplayName: String,
@@ -711,9 +716,10 @@ interface SomeChat {
 
 @Serializable @Stable
 data class Chat (
+  val remoteHostId: Long? = null,
   val chatInfo: ChatInfo,
   val chatItems: List<ChatItem>,
-  val chatStats: ChatStats = ChatStats(),
+  val chatStats: ChatStats = ChatStats()
 ) {
   val userCanSend: Boolean
     get() = when (chatInfo) {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
index 253a9fb16..ffb5b4251 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
@@ -4,6 +4,7 @@ import chat.simplex.common.views.helpers.*
 import androidx.compose.runtime.*
 import androidx.compose.ui.graphics.Color
 import androidx.compose.ui.graphics.painter.Painter
+import chat.simplex.common.model.ChatModel.remoteHostId
 import chat.simplex.common.model.ChatModel.updatingChatsMutex
 import dev.icerock.moko.resources.compose.painterResource
 import chat.simplex.common.platform.*
@@ -352,13 +353,13 @@ object ChatController {
       apiSetXFTPConfig(getXFTPCfg())
       apiSetEncryptLocalFiles(appPrefs.privacyEncryptLocalFiles.get())
       val justStarted = apiStartChat()
-      val users = listUsers()
+      val users = listUsers(null)
       chatModel.users.clear()
       chatModel.users.addAll(users)
       if (justStarted) {
         chatModel.currentUser.value = user
         chatModel.userCreated.value = true
-        getUserChatData()
+        getUserChatData(null)
         appPrefs.chatLastStart.set(Clock.System.now())
         chatModel.chatRunning.value = true
         startReceiver()
@@ -366,7 +367,7 @@ object ChatController {
         Log.d(TAG, "startChat: started")
       } else {
         updatingChatsMutex.withLock {
-          val chats = apiGetChats()
+          val chats = apiGetChats(null)
           chatModel.updateChats(chats)
         }
         Log.d(TAG, "startChat: running")
@@ -377,33 +378,33 @@ object ChatController {
     }
   }
 
-  suspend fun changeActiveUser(toUserId: Long, viewPwd: String?) {
+  suspend fun changeActiveUser(rhId: Long?, toUserId: Long, viewPwd: String?) {
     try {
-      changeActiveUser_(toUserId, viewPwd)
+      changeActiveUser_(rhId, toUserId, viewPwd)
     } catch (e: Exception) {
       Log.e(TAG, "Unable to set active user: ${e.stackTraceToString()}")
       AlertManager.shared.showAlertMsg(generalGetString(MR.strings.failed_to_active_user_title), e.stackTraceToString())
     }
   }
 
-  suspend fun changeActiveUser_(toUserId: Long, viewPwd: String?) {
-    val currentUser = apiSetActiveUser(toUserId, viewPwd)
+  suspend fun changeActiveUser_(rhId: Long?, toUserId: Long, viewPwd: String?) {
+    val currentUser = apiSetActiveUser(rhId, toUserId, viewPwd)
     chatModel.currentUser.value = currentUser
-    val users = listUsers()
+    val users = listUsers(rhId)
     chatModel.users.clear()
     chatModel.users.addAll(users)
-    getUserChatData()
+    getUserChatData(rhId)
     val invitation = chatModel.callInvitations.values.firstOrNull { inv -> inv.user.userId == toUserId }
     if (invitation != null) {
       chatModel.callManager.reportNewIncomingCall(invitation.copy(user = currentUser))
     }
   }
 
-  suspend fun getUserChatData() {
-    chatModel.userAddress.value = apiGetUserAddress()
-    chatModel.chatItemTTL.value = getChatItemTTL()
+  suspend fun getUserChatData(rhId: Long?) {
+    chatModel.userAddress.value = apiGetUserAddress(rhId)
+    chatModel.chatItemTTL.value = getChatItemTTL(rhId)
     updatingChatsMutex.withLock {
-      val chats = apiGetChats()
+      val chats = apiGetChats(rhId)
       chatModel.updateChats(chats)
     }
   }
@@ -428,21 +429,20 @@ object ChatController {
     }
   }
 
-  suspend fun sendCmd(cmd: CC, customRhId: Long? = null): CR {
+  suspend fun sendCmd(rhId: Long?, cmd: CC): CR {
     val ctrl = ctrl ?: throw Exception("Controller is not initialized")
 
     return withContext(Dispatchers.IO) {
       val c = cmd.cmdString
-      chatModel.addTerminalItem(TerminalItem.cmd(cmd.obfuscated))
+      chatModel.addTerminalItem(TerminalItem.cmd(rhId, cmd.obfuscated))
       Log.d(TAG, "sendCmd: ${cmd.cmdType}")
-      val rhId = customRhId?.toInt() ?: chatModel.currentRemoteHost.value?.remoteHostId?.toInt() ?: -1
-      val json = if (rhId == -1) chatSendCmd(ctrl, c) else chatSendRemoteCmd(ctrl, rhId, c)
+      val json = if (rhId == null) chatSendCmd(ctrl, c) else chatSendRemoteCmd(ctrl, rhId.toInt(), c)
       val r = APIResponse.decodeStr(json)
       Log.d(TAG, "sendCmd response type ${r.resp.responseType}")
       if (r.resp is CR.Response || r.resp is CR.Invalid) {
         Log.d(TAG, "sendCmd response json $json")
       }
-      chatModel.addTerminalItem(TerminalItem.resp(r.resp))
+      chatModel.addTerminalItem(TerminalItem.resp(rhId, r.resp))
       r.resp
     }
   }
@@ -460,16 +460,16 @@ object ChatController {
     }
   }
 
-  suspend fun apiGetActiveUser(): User? {
-    val r = sendCmd(CC.ShowActiveUser())
+  suspend fun apiGetActiveUser(rh: Long?): User? {
+    val r = sendCmd(rh, CC.ShowActiveUser())
     if (r is CR.ActiveUser) return r.user
     Log.d(TAG, "apiGetActiveUser: ${r.responseType} ${r.details}")
     chatModel.userCreated.value = false
     return null
   }
 
-  suspend fun apiCreateActiveUser(p: Profile?, sameServers: Boolean = false, pastTimestamp: Boolean = false): User? {
-    val r = sendCmd(CC.CreateActiveUser(p, sameServers = sameServers, pastTimestamp = pastTimestamp))
+  suspend fun apiCreateActiveUser(rh: Long?, p: Profile?, sameServers: Boolean = false, pastTimestamp: Boolean = false): User? {
+    val r = sendCmd(rh, CC.CreateActiveUser(p, sameServers = sameServers, pastTimestamp = pastTimestamp))
     if (r is CR.ActiveUser) return r.user
     else if (
       r is CR.ChatCmdError && r.chatError is ChatError.ChatErrorStore && r.chatError.storeError is StoreError.DuplicateName ||
@@ -483,65 +483,68 @@ object ChatController {
     return null
   }
 
-  suspend fun listUsers(): List<UserInfo> {
-    val r = sendCmd(CC.ListUsers())
-    if (r is CR.UsersList) return r.users.sortedBy { it.user.chatViewName }
+  suspend fun listUsers(rh: Long?): List<UserInfo> {
+    val r = sendCmd(rh, CC.ListUsers())
+    if (r is CR.UsersList) {
+      val users = if (rh == null) r.users else r.users.map { it.copy(user = it.user.copy(remoteHostId = rh)) }
+      return users.sortedBy { it.user.chatViewName }
+    }
     Log.d(TAG, "listUsers: ${r.responseType} ${r.details}")
     throw Exception("failed to list users ${r.responseType} ${r.details}")
   }
 
-  suspend fun apiSetActiveUser(userId: Long, viewPwd: String?): User {
-    val r = sendCmd(CC.ApiSetActiveUser(userId, viewPwd))
-    if (r is CR.ActiveUser) return r.user
+  suspend fun apiSetActiveUser(rh: Long?, userId: Long, viewPwd: String?): User {
+    val r = sendCmd(rh, CC.ApiSetActiveUser(userId, viewPwd))
+    if (r is CR.ActiveUser) return if (rh == null) r.user else r.user.copy(remoteHostId = rh)
     Log.d(TAG, "apiSetActiveUser: ${r.responseType} ${r.details}")
     throw Exception("failed to set the user as active ${r.responseType} ${r.details}")
   }
 
-  suspend fun apiSetAllContactReceipts(enable: Boolean) {
-    val r = sendCmd(CC.SetAllContactReceipts(enable))
+  suspend fun apiSetAllContactReceipts(rh: Long?, enable: Boolean) {
+    val r = sendCmd(rh, CC.SetAllContactReceipts(enable))
     if (r is CR.CmdOk) return
     throw Exception("failed to set receipts for all users ${r.responseType} ${r.details}")
   }
 
-  suspend fun apiSetUserContactReceipts(userId: Long, userMsgReceiptSettings: UserMsgReceiptSettings) {
-    val r = sendCmd(CC.ApiSetUserContactReceipts(userId, userMsgReceiptSettings))
+  suspend fun apiSetUserContactReceipts(u: User, userMsgReceiptSettings: UserMsgReceiptSettings) {
+    val r = sendCmd(u.remoteHostId, CC.ApiSetUserContactReceipts(u.userId, userMsgReceiptSettings))
     if (r is CR.CmdOk) return
     throw Exception("failed to set receipts for user contacts ${r.responseType} ${r.details}")
   }
 
-  suspend fun apiSetUserGroupReceipts(userId: Long, userMsgReceiptSettings: UserMsgReceiptSettings) {
-    val r = sendCmd(CC.ApiSetUserGroupReceipts(userId, userMsgReceiptSettings))
+  suspend fun apiSetUserGroupReceipts(u: User, userMsgReceiptSettings: UserMsgReceiptSettings) {
+    val r = sendCmd(u.remoteHostId, CC.ApiSetUserGroupReceipts(u.userId, userMsgReceiptSettings))
     if (r is CR.CmdOk) return
     throw Exception("failed to set receipts for user groups ${r.responseType} ${r.details}")
   }
 
-  suspend fun apiHideUser(userId: Long, viewPwd: String): User =
-    setUserPrivacy(CC.ApiHideUser(userId, viewPwd))
+  suspend fun apiHideUser(u: User, viewPwd: String): User =
+    setUserPrivacy(u.remoteHostId, CC.ApiHideUser(u.userId, viewPwd))
 
-  suspend fun apiUnhideUser(userId: Long, viewPwd: String): User =
-    setUserPrivacy(CC.ApiUnhideUser(userId, viewPwd))
+  suspend fun apiUnhideUser(u: User, viewPwd: String): User =
+    setUserPrivacy(u.remoteHostId, CC.ApiUnhideUser(u.userId, viewPwd))
 
-  suspend fun apiMuteUser(userId: Long): User =
-    setUserPrivacy(CC.ApiMuteUser(userId))
+  suspend fun apiMuteUser(u: User): User =
+    setUserPrivacy(u.remoteHostId, CC.ApiMuteUser(u.userId))
 
-  suspend fun apiUnmuteUser(userId: Long): User =
-    setUserPrivacy(CC.ApiUnmuteUser(userId))
+  suspend fun apiUnmuteUser(u: User): User =
+    setUserPrivacy(u.remoteHostId, CC.ApiUnmuteUser(u.userId))
 
-  private suspend fun setUserPrivacy(cmd: CC): User {
-    val r = sendCmd(cmd)
-    if (r is CR.UserPrivacy) return r.updatedUser
+  private suspend fun setUserPrivacy(rh: Long?, cmd: CC): User {
+    val r = sendCmd(rh, cmd)
+    if (r is CR.UserPrivacy) return if (rh == null) r.updatedUser else r.updatedUser.copy(remoteHostId = rh)
     else throw Exception("Failed to change user privacy: ${r.responseType} ${r.details}")
   }
 
-  suspend fun apiDeleteUser(userId: Long, delSMPQueues: Boolean, viewPwd: String?) {
-    val r = sendCmd(CC.ApiDeleteUser(userId, delSMPQueues, viewPwd))
+  suspend fun apiDeleteUser(u: User, delSMPQueues: Boolean, viewPwd: String?) {
+    val r = sendCmd(u.remoteHostId, CC.ApiDeleteUser(u.userId, delSMPQueues, viewPwd))
     if (r is CR.CmdOk) return
     Log.d(TAG, "apiDeleteUser: ${r.responseType} ${r.details}")
     throw Exception("failed to delete the user ${r.responseType} ${r.details}")
   }
 
   suspend fun apiStartChat(): Boolean {
-    val r = sendCmd(CC.StartChat(expire = true))
+    val r = sendCmd(null, CC.StartChat(expire = true))
     when (r) {
       is CR.ChatStarted -> return true
       is CR.ChatRunning -> return false
@@ -550,7 +553,7 @@ object ChatController {
   }
 
   suspend fun apiStopChat(): Boolean {
-    val r = sendCmd(CC.ApiStopChat())
+    val r = sendCmd(null, CC.ApiStopChat())
     when (r) {
       is CR.ChatStopped -> return true
       else -> throw Error("failed stopping chat: ${r.responseType} ${r.details}")
@@ -558,76 +561,76 @@ object ChatController {
   }
 
   private suspend fun apiSetTempFolder(tempFolder: String) {
-    val r = sendCmd(CC.SetTempFolder(tempFolder))
+    val r = sendCmd(null, CC.SetTempFolder(tempFolder))
     if (r is CR.CmdOk) return
     throw Error("failed to set temp folder: ${r.responseType} ${r.details}")
   }
 
   private suspend fun apiSetFilesFolder(filesFolder: String) {
-    val r = sendCmd(CC.SetFilesFolder(filesFolder))
+    val r = sendCmd(null, CC.SetFilesFolder(filesFolder))
     if (r is CR.CmdOk) return
     throw Error("failed to set files folder: ${r.responseType} ${r.details}")
   }
 
   private suspend fun apiSetRemoteHostsFolder(remoteHostsFolder: String) {
-    val r = sendCmd(CC.SetRemoteHostsFolder(remoteHostsFolder))
+    val r = sendCmd(null, CC.SetRemoteHostsFolder(remoteHostsFolder))
     if (r is CR.CmdOk) return
     throw Error("failed to set remote hosts folder: ${r.responseType} ${r.details}")
   }
 
   suspend fun apiSetXFTPConfig(cfg: XFTPFileConfig?) {
-    val r = sendCmd(CC.ApiSetXFTPConfig(cfg))
+    val r = sendCmd(null, CC.ApiSetXFTPConfig(cfg))
     if (r is CR.CmdOk) return
     throw Error("apiSetXFTPConfig bad response: ${r.responseType} ${r.details}")
   }
 
-  suspend fun apiSetEncryptLocalFiles(enable: Boolean) = sendCommandOkResp(CC.ApiSetEncryptLocalFiles(enable))
+  suspend fun apiSetEncryptLocalFiles(enable: Boolean) = sendCommandOkResp(null, CC.ApiSetEncryptLocalFiles(enable))
 
   suspend fun apiExportArchive(config: ArchiveConfig) {
-    val r = sendCmd(CC.ApiExportArchive(config))
+    val r = sendCmd(null, CC.ApiExportArchive(config))
     if (r is CR.CmdOk) return
     throw Error("failed to export archive: ${r.responseType} ${r.details}")
   }
 
   suspend fun apiImportArchive(config: ArchiveConfig): List<ArchiveError> {
-    val r = sendCmd(CC.ApiImportArchive(config))
+    val r = sendCmd(null, CC.ApiImportArchive(config))
     if (r is CR.ArchiveImported) return r.archiveErrors
     throw Error("failed to import archive: ${r.responseType} ${r.details}")
   }
 
   suspend fun apiDeleteStorage() {
-    val r = sendCmd(CC.ApiDeleteStorage())
+    val r = sendCmd(null, CC.ApiDeleteStorage())
     if (r is CR.CmdOk) return
     throw Error("failed to delete storage: ${r.responseType} ${r.details}")
   }
 
   suspend fun apiStorageEncryption(currentKey: String = "", newKey: String = ""): CR.ChatCmdError? {
-    val r = sendCmd(CC.ApiStorageEncryption(DBEncryptionConfig(currentKey, newKey)))
+    val r = sendCmd(null, CC.ApiStorageEncryption(DBEncryptionConfig(currentKey, newKey)))
     if (r is CR.CmdOk) return null
     else if (r is CR.ChatCmdError) return r
     throw Exception("failed to set storage encryption: ${r.responseType} ${r.details}")
   }
 
-  suspend fun apiGetChats(): List<Chat> {
+  suspend fun apiGetChats(rh: Long?): List<Chat> {
     val userId = kotlin.runCatching { currentUserId("apiGetChats") }.getOrElse { return emptyList() }
-    val r = sendCmd(CC.ApiGetChats(userId))
-    if (r is CR.ApiChats) return r.chats
+    val r = sendCmd(rh, CC.ApiGetChats(userId))
+    if (r is CR.ApiChats) return if (rh == null) r.chats else r.chats.map { it.copy(remoteHostId = rh) }
     Log.e(TAG, "failed getting the list of chats: ${r.responseType} ${r.details}")
     AlertManager.shared.showAlertMsg(generalGetString(MR.strings.failed_to_parse_chats_title), generalGetString(MR.strings.contact_developers))
     return emptyList()
   }
 
-  suspend fun apiGetChat(type: ChatType, id: Long, pagination: ChatPagination = ChatPagination.Last(ChatPagination.INITIAL_COUNT), search: String = ""): Chat? {
-    val r = sendCmd(CC.ApiGetChat(type, id, pagination, search))
-    if (r is CR.ApiChat) return r.chat
+  suspend fun apiGetChat(rh: Long?, type: ChatType, id: Long, pagination: ChatPagination = ChatPagination.Last(ChatPagination.INITIAL_COUNT), search: String = ""): Chat? {
+    val r = sendCmd(rh, CC.ApiGetChat(type, id, pagination, search))
+    if (r is CR.ApiChat) return if (rh == null) r.chat else r.chat.copy(remoteHostId = rh)
     Log.e(TAG, "apiGetChat bad response: ${r.responseType} ${r.details}")
     AlertManager.shared.showAlertMsg(generalGetString(MR.strings.failed_to_parse_chat_title), generalGetString(MR.strings.contact_developers))
     return null
   }
 
-  suspend fun apiSendMessage(rhId: Long?, type: ChatType, id: Long, file: CryptoFile? = null, quotedItemId: Long? = null, mc: MsgContent, live: Boolean = false, ttl: Int? = null): AChatItem? {
+  suspend fun apiSendMessage(rh: Long?, type: ChatType, id: Long, file: CryptoFile? = null, quotedItemId: Long? = null, mc: MsgContent, live: Boolean = false, ttl: Int? = null): AChatItem? {
     val cmd = CC.ApiSendMessage(type, id, file, quotedItemId, mc, live, ttl)
-    val r = sendCmd(cmd, rhId)
+    val r = sendCmd(rh, cmd)
     return when (r) {
       is CR.NewChatItem -> r.chatItem
       else -> {
@@ -639,8 +642,8 @@ object ChatController {
     }
   }
 
-  suspend fun apiGetChatItemInfo(type: ChatType, id: Long, itemId: Long): ChatItemInfo? {
-    return when (val r = sendCmd(CC.ApiGetChatItemInfo(type, id, itemId))) {
+  suspend fun apiGetChatItemInfo(rh: Long?, type: ChatType, id: Long, itemId: Long): ChatItemInfo? {
+    return when (val r = sendCmd(rh, CC.ApiGetChatItemInfo(type, id, itemId))) {
       is CR.ApiChatItemInfo -> r.chatItemInfo
       else -> {
         apiErrorAlert("apiGetChatItemInfo", generalGetString(MR.strings.error_loading_details), r)
@@ -649,38 +652,38 @@ object ChatController {
     }
   }
 
-  suspend fun apiUpdateChatItem(type: ChatType, id: Long, itemId: Long, mc: MsgContent, live: Boolean = false): AChatItem? {
-    val r = sendCmd(CC.ApiUpdateChatItem(type, id, itemId, mc, live))
+  suspend fun apiUpdateChatItem(rh: Long?, type: ChatType, id: Long, itemId: Long, mc: MsgContent, live: Boolean = false): AChatItem? {
+    val r = sendCmd(rh, CC.ApiUpdateChatItem(type, id, itemId, mc, live))
     if (r is CR.ChatItemUpdated) return r.chatItem
     Log.e(TAG, "apiUpdateChatItem bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiChatItemReaction(type: ChatType, id: Long, itemId: Long, add: Boolean, reaction: MsgReaction): ChatItem? {
-    val r = sendCmd(CC.ApiChatItemReaction(type, id, itemId, add, reaction))
+  suspend fun apiChatItemReaction(rh: Long?, type: ChatType, id: Long, itemId: Long, add: Boolean, reaction: MsgReaction): ChatItem? {
+    val r = sendCmd(rh, CC.ApiChatItemReaction(type, id, itemId, add, reaction))
     if (r is CR.ChatItemReaction) return r.reaction.chatReaction.chatItem
     Log.e(TAG, "apiUpdateChatItem bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiDeleteChatItem(type: ChatType, id: Long, itemId: Long, mode: CIDeleteMode): CR.ChatItemDeleted? {
-    val r = sendCmd(CC.ApiDeleteChatItem(type, id, itemId, mode))
+  suspend fun apiDeleteChatItem(rh: Long?, type: ChatType, id: Long, itemId: Long, mode: CIDeleteMode): CR.ChatItemDeleted? {
+    val r = sendCmd(rh, CC.ApiDeleteChatItem(type, id, itemId, mode))
     if (r is CR.ChatItemDeleted) return r
     Log.e(TAG, "apiDeleteChatItem bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiDeleteMemberChatItem(groupId: Long, groupMemberId: Long, itemId: Long): Pair<ChatItem, ChatItem?>? {
-    val r = sendCmd(CC.ApiDeleteMemberChatItem(groupId, groupMemberId, itemId))
+  suspend fun apiDeleteMemberChatItem(rh: Long?, groupId: Long, groupMemberId: Long, itemId: Long): Pair<ChatItem, ChatItem?>? {
+    val r = sendCmd(rh, CC.ApiDeleteMemberChatItem(groupId, groupMemberId, itemId))
     if (r is CR.ChatItemDeleted) return r.deletedChatItem.chatItem to r.toChatItem?.chatItem
     Log.e(TAG, "apiDeleteMemberChatItem bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun getUserProtoServers(serverProtocol: ServerProtocol): UserProtocolServers? {
+  suspend fun getUserProtoServers(rh: Long?, serverProtocol: ServerProtocol): UserProtocolServers? {
     val userId = kotlin.runCatching { currentUserId("getUserProtoServers") }.getOrElse { return null }
-    val r = sendCmd(CC.APIGetUserProtoServers(userId, serverProtocol))
-    return if (r is CR.UserProtoServers) r.servers
+    val r = sendCmd(rh, CC.APIGetUserProtoServers(userId, serverProtocol))
+    return if (r is CR.UserProtoServers) { if (rh == null) r.servers else r.servers.copy(protoServers = r.servers.protoServers.map { it.copy(remoteHostId = rh) }) }
     else {
       Log.e(TAG, "getUserProtoServers bad response: ${r.responseType} ${r.details}")
       AlertManager.shared.showAlertMsg(
@@ -691,9 +694,9 @@ object ChatController {
     }
   }
 
-  suspend fun setUserProtoServers(serverProtocol: ServerProtocol, servers: List<ServerCfg>): Boolean {
+  suspend fun setUserProtoServers(rh: Long?, serverProtocol: ServerProtocol, servers: List<ServerCfg>): Boolean {
     val userId = kotlin.runCatching { currentUserId("setUserProtoServers") }.getOrElse { return false }
-    val r = sendCmd(CC.APISetUserProtoServers(userId, serverProtocol, servers))
+    val r = sendCmd(rh, CC.APISetUserProtoServers(userId, serverProtocol, servers))
     return when (r) {
       is CR.CmdOk -> true
       else -> {
@@ -707,9 +710,9 @@ object ChatController {
     }
   }
 
-  suspend fun testProtoServer(server: String): ProtocolTestFailure? {
+  suspend fun testProtoServer(rh: Long?, server: String): ProtocolTestFailure? {
     val userId = currentUserId("testProtoServer")
-    val r = sendCmd(CC.APITestProtoServer(userId, server))
+    val r = sendCmd(rh, CC.APITestProtoServer(userId, server))
     return when (r) {
       is CR.ServerTestResult -> r.testFailure
       else -> {
@@ -719,29 +722,22 @@ object ChatController {
     }
   }
 
-  suspend fun getChatItemTTL(): ChatItemTTL {
+  suspend fun getChatItemTTL(rh: Long?): ChatItemTTL {
     val userId = currentUserId("getChatItemTTL")
-    val r = sendCmd(CC.APIGetChatItemTTL(userId))
+    val r = sendCmd(rh, CC.APIGetChatItemTTL(userId))
     if (r is CR.ChatItemTTL) return ChatItemTTL.fromSeconds(r.chatItemTTL)
     throw Exception("failed to get chat item TTL: ${r.responseType} ${r.details}")
   }
 
-  suspend fun setChatItemTTL(chatItemTTL: ChatItemTTL) {
+  suspend fun setChatItemTTL(rh: Long?, chatItemTTL: ChatItemTTL) {
     val userId = currentUserId("setChatItemTTL")
-    val r = sendCmd(CC.APISetChatItemTTL(userId, chatItemTTL.seconds))
+    val r = sendCmd(rh, CC.APISetChatItemTTL(userId, chatItemTTL.seconds))
     if (r is CR.CmdOk) return
     throw Exception("failed to set chat item TTL: ${r.responseType} ${r.details}")
   }
 
-  suspend fun apiGetNetworkConfig(): NetCfg? {
-    val r = sendCmd(CC.APIGetNetworkConfig())
-    if (r is CR.NetworkConfig) return r.networkConfig
-    Log.e(TAG, "apiGetNetworkConfig bad response: ${r.responseType} ${r.details}")
-    return null
-  }
-
   suspend fun apiSetNetworkConfig(cfg: NetCfg): Boolean {
-    val r = sendCmd(CC.APISetNetworkConfig(cfg))
+    val r = sendCmd(null, CC.APISetNetworkConfig(cfg))
     return when (r) {
       is CR.CmdOk -> true
       else -> {
@@ -755,8 +751,8 @@ object ChatController {
     }
   }
 
-  suspend fun apiSetSettings(type: ChatType, id: Long, settings: ChatSettings): Boolean {
-    val r = sendCmd(CC.APISetChatSettings(type, id, settings))
+  suspend fun apiSetSettings(rh: Long?, type: ChatType, id: Long, settings: ChatSettings): Boolean {
+    val r = sendCmd(rh, CC.APISetChatSettings(type, id, settings))
     return when (r) {
       is CR.CmdOk -> true
       else -> {
@@ -766,88 +762,88 @@ object ChatController {
     }
   }
 
-  suspend fun apiSetMemberSettings(groupId: Long, groupMemberId: Long, memberSettings: GroupMemberSettings): Boolean =
-    sendCommandOkResp(CC.ApiSetMemberSettings(groupId, groupMemberId, memberSettings))
+  suspend fun apiSetMemberSettings(rh: Long?, groupId: Long, groupMemberId: Long, memberSettings: GroupMemberSettings): Boolean =
+    sendCommandOkResp(rh, CC.ApiSetMemberSettings(groupId, groupMemberId, memberSettings))
 
-  suspend fun apiContactInfo(contactId: Long): Pair<ConnectionStats?, Profile?>? {
-    val r = sendCmd(CC.APIContactInfo(contactId))
+  suspend fun apiContactInfo(rh: Long?, contactId: Long): Pair<ConnectionStats?, Profile?>? {
+    val r = sendCmd(rh, CC.APIContactInfo(contactId))
     if (r is CR.ContactInfo) return r.connectionStats_ to r.customUserProfile
     Log.e(TAG, "apiContactInfo bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiGroupMemberInfo(groupId: Long, groupMemberId: Long): Pair<GroupMember, ConnectionStats?>? {
-    val r = sendCmd(CC.APIGroupMemberInfo(groupId, groupMemberId))
+  suspend fun apiGroupMemberInfo(rh: Long?, groupId: Long, groupMemberId: Long): Pair<GroupMember, ConnectionStats?>? {
+    val r = sendCmd(rh, CC.APIGroupMemberInfo(groupId, groupMemberId))
     if (r is CR.GroupMemberInfo) return Pair(r.member, r.connectionStats_)
     Log.e(TAG, "apiGroupMemberInfo bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiSwitchContact(contactId: Long): ConnectionStats? {
-    val r = sendCmd(CC.APISwitchContact(contactId))
+  suspend fun apiSwitchContact(rh: Long?, contactId: Long): ConnectionStats? {
+    val r = sendCmd(rh, CC.APISwitchContact(contactId))
     if (r is CR.ContactSwitchStarted) return r.connectionStats
     apiErrorAlert("apiSwitchContact", generalGetString(MR.strings.error_changing_address), r)
     return null
   }
 
-  suspend fun apiSwitchGroupMember(groupId: Long, groupMemberId: Long): Pair<GroupMember, ConnectionStats>? {
-    val r = sendCmd(CC.APISwitchGroupMember(groupId, groupMemberId))
+  suspend fun apiSwitchGroupMember(rh: Long?, groupId: Long, groupMemberId: Long): Pair<GroupMember, ConnectionStats>? {
+    val r = sendCmd(rh, CC.APISwitchGroupMember(groupId, groupMemberId))
     if (r is CR.GroupMemberSwitchStarted) return Pair(r.member, r.connectionStats)
     apiErrorAlert("apiSwitchGroupMember", generalGetString(MR.strings.error_changing_address), r)
     return null
   }
 
-  suspend fun apiAbortSwitchContact(contactId: Long): ConnectionStats? {
-    val r = sendCmd(CC.APIAbortSwitchContact(contactId))
+  suspend fun apiAbortSwitchContact(rh: Long?, contactId: Long): ConnectionStats? {
+    val r = sendCmd(rh, CC.APIAbortSwitchContact(contactId))
     if (r is CR.ContactSwitchAborted) return r.connectionStats
     apiErrorAlert("apiAbortSwitchContact", generalGetString(MR.strings.error_aborting_address_change), r)
     return null
   }
 
-  suspend fun apiAbortSwitchGroupMember(groupId: Long, groupMemberId: Long): Pair<GroupMember, ConnectionStats>? {
-    val r = sendCmd(CC.APIAbortSwitchGroupMember(groupId, groupMemberId))
+  suspend fun apiAbortSwitchGroupMember(rh: Long?, groupId: Long, groupMemberId: Long): Pair<GroupMember, ConnectionStats>? {
+    val r = sendCmd(rh, CC.APIAbortSwitchGroupMember(groupId, groupMemberId))
     if (r is CR.GroupMemberSwitchAborted) return Pair(r.member, r.connectionStats)
     apiErrorAlert("apiAbortSwitchGroupMember", generalGetString(MR.strings.error_aborting_address_change), r)
     return null
   }
 
-  suspend fun apiSyncContactRatchet(contactId: Long, force: Boolean): ConnectionStats? {
-    val r = sendCmd(CC.APISyncContactRatchet(contactId, force))
+  suspend fun apiSyncContactRatchet(rh: Long?, contactId: Long, force: Boolean): ConnectionStats? {
+    val r = sendCmd(rh, CC.APISyncContactRatchet(contactId, force))
     if (r is CR.ContactRatchetSyncStarted) return r.connectionStats
     apiErrorAlert("apiSyncContactRatchet", generalGetString(MR.strings.error_synchronizing_connection), r)
     return null
   }
 
-  suspend fun apiSyncGroupMemberRatchet(groupId: Long, groupMemberId: Long, force: Boolean): Pair<GroupMember, ConnectionStats>? {
-    val r = sendCmd(CC.APISyncGroupMemberRatchet(groupId, groupMemberId, force))
+  suspend fun apiSyncGroupMemberRatchet(rh: Long?, groupId: Long, groupMemberId: Long, force: Boolean): Pair<GroupMember, ConnectionStats>? {
+    val r = sendCmd(rh, CC.APISyncGroupMemberRatchet(groupId, groupMemberId, force))
     if (r is CR.GroupMemberRatchetSyncStarted) return Pair(r.member, r.connectionStats)
     apiErrorAlert("apiSyncGroupMemberRatchet", generalGetString(MR.strings.error_synchronizing_connection), r)
     return null
   }
 
-  suspend fun apiGetContactCode(contactId: Long): Pair<Contact, String>? {
-    val r = sendCmd(CC.APIGetContactCode(contactId))
+  suspend fun apiGetContactCode(rh: Long?, contactId: Long): Pair<Contact, String>? {
+    val r = sendCmd(rh, CC.APIGetContactCode(contactId))
     if (r is CR.ContactCode) return r.contact to r.connectionCode
     Log.e(TAG,"failed to get contact code: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiGetGroupMemberCode(groupId: Long, groupMemberId: Long): Pair<GroupMember, String>? {
-    val r = sendCmd(CC.APIGetGroupMemberCode(groupId, groupMemberId))
+  suspend fun apiGetGroupMemberCode(rh: Long?, groupId: Long, groupMemberId: Long): Pair<GroupMember, String>? {
+    val r = sendCmd(rh, CC.APIGetGroupMemberCode(groupId, groupMemberId))
     if (r is CR.GroupMemberCode) return r.member to r.connectionCode
     Log.e(TAG,"failed to get group member code: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiVerifyContact(contactId: Long, connectionCode: String?): Pair<Boolean, String>? {
-    return when (val r = sendCmd(CC.APIVerifyContact(contactId, connectionCode))) {
+  suspend fun apiVerifyContact(rh: Long?, contactId: Long, connectionCode: String?): Pair<Boolean, String>? {
+    return when (val r = sendCmd(rh, CC.APIVerifyContact(contactId, connectionCode))) {
       is CR.ConnectionVerified -> r.verified to r.expectedCode
       else -> null
     }
   }
 
-  suspend fun apiVerifyGroupMember(groupId: Long, groupMemberId: Long, connectionCode: String?): Pair<Boolean, String>? {
-    return when (val r = sendCmd(CC.APIVerifyGroupMember(groupId, groupMemberId, connectionCode))) {
+  suspend fun apiVerifyGroupMember(rh: Long?, groupId: Long, groupMemberId: Long, connectionCode: String?): Pair<Boolean, String>? {
+    return when (val r = sendCmd(rh, CC.APIVerifyGroupMember(groupId, groupMemberId, connectionCode))) {
       is CR.ConnectionVerified -> r.verified to r.expectedCode
       else -> null
     }
@@ -855,12 +851,12 @@ object ChatController {
 
 
 
-  suspend fun apiAddContact(incognito: Boolean): Pair<String, PendingContactConnection>? {
+  suspend fun apiAddContact(rh: Long?, incognito: Boolean): Pair<String, PendingContactConnection>? {
     val userId = chatModel.currentUser.value?.userId ?: run {
       Log.e(TAG, "apiAddContact: no current user")
       return null
     }
-    val r = sendCmd(CC.APIAddContact(userId, incognito))
+    val r = sendCmd(rh, CC.APIAddContact(userId, incognito))
     return when (r) {
       is CR.Invitation -> r.connReqInvitation to r.connection
       else -> {
@@ -872,27 +868,27 @@ object ChatController {
     }
   }
 
-  suspend fun apiSetConnectionIncognito(connId: Long, incognito: Boolean): PendingContactConnection? {
-    val r = sendCmd(CC.ApiSetConnectionIncognito(connId, incognito))
+  suspend fun apiSetConnectionIncognito(rh: Long?, connId: Long, incognito: Boolean): PendingContactConnection? {
+    val r = sendCmd(rh, CC.ApiSetConnectionIncognito(connId, incognito))
     if (r is CR.ConnectionIncognitoUpdated) return r.toConnection
     Log.e(TAG, "apiSetConnectionIncognito bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiConnectPlan(connReq: String): ConnectionPlan? {
+  suspend fun apiConnectPlan(rh: Long?, connReq: String): ConnectionPlan? {
     val userId = kotlin.runCatching { currentUserId("apiConnectPlan") }.getOrElse { return null }
-    val r = sendCmd(CC.APIConnectPlan(userId, connReq))
+    val r = sendCmd(rh, CC.APIConnectPlan(userId, connReq))
     if (r is CR.CRConnectionPlan) return r.connectionPlan
     Log.e(TAG, "apiConnectPlan bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiConnect(incognito: Boolean, connReq: String): Boolean  {
+  suspend fun apiConnect(rh: Long?, incognito: Boolean, connReq: String): Boolean  {
     val userId = chatModel.currentUser.value?.userId ?: run {
       Log.e(TAG, "apiConnect: no current user")
       return false
     }
-    val r = sendCmd(CC.APIConnect(userId, incognito, connReq))
+    val r = sendCmd(rh, CC.APIConnect(userId, incognito, connReq))
     when {
       r is CR.SentConfirmation || r is CR.SentInvitation -> return true
       r is CR.ContactAlreadyExists -> {
@@ -928,12 +924,12 @@ object ChatController {
     }
   }
 
-  suspend fun apiConnectContactViaAddress(incognito: Boolean, contactId: Long): Contact? {
+  suspend fun apiConnectContactViaAddress(rh: Long?, incognito: Boolean, contactId: Long): Contact? {
     val userId = chatModel.currentUser.value?.userId ?: run {
       Log.e(TAG, "apiConnectContactViaAddress: no current user")
       return null
     }
-    val r = sendCmd(CC.ApiConnectContactViaAddress(userId, incognito, contactId))
+    val r = sendCmd(rh, CC.ApiConnectContactViaAddress(userId, incognito, contactId))
     when {
       r is CR.SentInvitationToContact -> return r.contact
       else -> {
@@ -945,8 +941,8 @@ object ChatController {
     }
   }
 
-  suspend fun apiDeleteChat(type: ChatType, id: Long, notify: Boolean? = null): Boolean {
-    val r = sendCmd(CC.ApiDeleteChat(type, id, notify))
+  suspend fun apiDeleteChat(rh: Long?, type: ChatType, id: Long, notify: Boolean? = null): Boolean {
+    val r = sendCmd(rh, CC.ApiDeleteChat(type, id, notify))
     when {
       r is CR.ContactDeleted && type == ChatType.Direct -> return true
       r is CR.ContactConnectionDeleted && type == ChatType.ContactConnection -> return true
@@ -964,24 +960,16 @@ object ChatController {
     return false
   }
 
-  suspend fun apiClearChat(type: ChatType, id: Long): ChatInfo? {
-    val r = sendCmd(CC.ApiClearChat(type, id))
+  suspend fun apiClearChat(rh: Long?, type: ChatType, id: Long): ChatInfo? {
+    val r = sendCmd(rh, CC.ApiClearChat(type, id))
     if (r is CR.ChatCleared) return r.chatInfo
     Log.e(TAG, "apiClearChat bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiListContacts(): List<Contact>? {
-    val userId = kotlin.runCatching { currentUserId("apiListContacts") }.getOrElse { return null }
-    val r = sendCmd(CC.ApiListContacts(userId))
-    if (r is CR.ContactsList) return r.contacts
-    Log.e(TAG, "apiListContacts bad response: ${r.responseType} ${r.details}")
-    return null
-  }
-
-  suspend fun apiUpdateProfile(profile: Profile): Pair<Profile, List<Contact>>? {
+  suspend fun apiUpdateProfile(rh: Long?, profile: Profile): Pair<Profile, List<Contact>>? {
     val userId = kotlin.runCatching { currentUserId("apiUpdateProfile") }.getOrElse { return null }
-    val r = sendCmd(CC.ApiUpdateProfile(userId, profile))
+    val r = sendCmd(rh, CC.ApiUpdateProfile(userId, profile))
     if (r is CR.UserProfileNoChange) return profile to emptyList()
     if (r is CR.UserProfileUpdated) return r.toProfile to r.updateSummary.changedContacts
     if (r is CR.ChatCmdError && r.chatError is ChatError.ChatErrorStore && r.chatError.storeError is StoreError.DuplicateName) {
@@ -991,39 +979,39 @@ object ChatController {
     return null
   }
 
-  suspend fun apiSetProfileAddress(on: Boolean): User? {
+  suspend fun apiSetProfileAddress(rh: Long?, on: Boolean): User? {
     val userId = try { currentUserId("apiSetProfileAddress") } catch (e: Exception) { return null }
-    return when (val r = sendCmd(CC.ApiSetProfileAddress(userId, on))) {
+    return when (val r = sendCmd(rh, CC.ApiSetProfileAddress(userId, on))) {
       is CR.UserProfileNoChange -> null
       is CR.UserProfileUpdated -> r.user
       else -> throw Exception("failed to set profile address: ${r.responseType} ${r.details}")
     }
   }
 
-  suspend fun apiSetContactPrefs(contactId: Long, prefs: ChatPreferences): Contact? {
-    val r = sendCmd(CC.ApiSetContactPrefs(contactId, prefs))
+  suspend fun apiSetContactPrefs(rh: Long?, contactId: Long, prefs: ChatPreferences): Contact? {
+    val r = sendCmd(rh, CC.ApiSetContactPrefs(contactId, prefs))
     if (r is CR.ContactPrefsUpdated) return r.toContact
     Log.e(TAG, "apiSetContactPrefs bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiSetContactAlias(contactId: Long, localAlias: String): Contact? {
-    val r = sendCmd(CC.ApiSetContactAlias(contactId, localAlias))
+  suspend fun apiSetContactAlias(rh: Long?, contactId: Long, localAlias: String): Contact? {
+    val r = sendCmd(rh, CC.ApiSetContactAlias(contactId, localAlias))
     if (r is CR.ContactAliasUpdated) return r.toContact
     Log.e(TAG, "apiSetContactAlias bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiSetConnectionAlias(connId: Long, localAlias: String): PendingContactConnection? {
-    val r = sendCmd(CC.ApiSetConnectionAlias(connId, localAlias))
+  suspend fun apiSetConnectionAlias(rh: Long?, connId: Long, localAlias: String): PendingContactConnection? {
+    val r = sendCmd(rh, CC.ApiSetConnectionAlias(connId, localAlias))
     if (r is CR.ConnectionAliasUpdated) return r.toConnection
     Log.e(TAG, "apiSetConnectionAlias bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiCreateUserAddress(): String? {
+  suspend fun apiCreateUserAddress(rh: Long?): String? {
     val userId = kotlin.runCatching { currentUserId("apiCreateUserAddress") }.getOrElse { return null }
-    val r = sendCmd(CC.ApiCreateMyAddress(userId))
+    val r = sendCmd(rh, CC.ApiCreateMyAddress(userId))
     return when (r) {
       is CR.UserContactLinkCreated -> r.connReqContact
       else -> {
@@ -1035,17 +1023,17 @@ object ChatController {
     }
   }
 
-  suspend fun apiDeleteUserAddress(): User? {
+  suspend fun apiDeleteUserAddress(rh: Long?): User? {
     val userId = try { currentUserId("apiDeleteUserAddress") } catch (e: Exception) { return null }
-    val r = sendCmd(CC.ApiDeleteMyAddress(userId))
+    val r = sendCmd(rh, CC.ApiDeleteMyAddress(userId))
     if (r is CR.UserContactLinkDeleted) return r.user
     Log.e(TAG, "apiDeleteUserAddress bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  private suspend fun apiGetUserAddress(): UserContactLinkRec? {
+  private suspend fun apiGetUserAddress(rh: Long?): UserContactLinkRec? {
     val userId = kotlin.runCatching { currentUserId("apiGetUserAddress") }.getOrElse { return null }
-    val r = sendCmd(CC.ApiShowMyAddress(userId))
+    val r = sendCmd(rh, CC.ApiShowMyAddress(userId))
     if (r is CR.UserContactLink) return r.contactLink
     if (r is CR.ChatCmdError && r.chatError is ChatError.ChatErrorStore
       && r.chatError.storeError is StoreError.UserContactLinkNotFound
@@ -1056,9 +1044,9 @@ object ChatController {
     return null
   }
 
-  suspend fun userAddressAutoAccept(autoAccept: AutoAccept?): UserContactLinkRec? {
+  suspend fun userAddressAutoAccept(rh: Long?, autoAccept: AutoAccept?): UserContactLinkRec? {
     val userId = kotlin.runCatching { currentUserId("userAddressAutoAccept") }.getOrElse { return null }
-    val r = sendCmd(CC.ApiAddressAutoAccept(userId, autoAccept))
+    val r = sendCmd(rh, CC.ApiAddressAutoAccept(userId, autoAccept))
     if (r is CR.UserContactLinkUpdated) return r.contactLink
     if (r is CR.ChatCmdError && r.chatError is ChatError.ChatErrorStore
       && r.chatError.storeError is StoreError.UserContactLinkNotFound
@@ -1069,8 +1057,8 @@ object ChatController {
     return null
   }
 
-  suspend fun apiAcceptContactRequest(incognito: Boolean, contactReqId: Long): Contact? {
-    val r = sendCmd(CC.ApiAcceptContact(incognito, contactReqId))
+  suspend fun apiAcceptContactRequest(rh: Long?, incognito: Boolean, contactReqId: Long): Contact? {
+    val r = sendCmd(rh, CC.ApiAcceptContact(incognito, contactReqId))
     return when {
       r is CR.AcceptingContactRequest -> r.contact
       r is CR.ChatCmdError && r.chatError is ChatError.ChatErrorAgent
@@ -1091,76 +1079,76 @@ object ChatController {
     }
   }
 
-  suspend fun apiRejectContactRequest(contactReqId: Long): Boolean {
-    val r = sendCmd(CC.ApiRejectContact(contactReqId))
+  suspend fun apiRejectContactRequest(rh: Long?, contactReqId: Long): Boolean {
+    val r = sendCmd(rh, CC.ApiRejectContact(contactReqId))
     if (r is CR.ContactRequestRejected) return true
     Log.e(TAG, "apiRejectContactRequest bad response: ${r.responseType} ${r.details}")
     return false
   }
 
-  suspend fun apiSendCallInvitation(contact: Contact, callType: CallType): Boolean {
-    val r = sendCmd(CC.ApiSendCallInvitation(contact, callType))
+  suspend fun apiSendCallInvitation(rh: Long?, contact: Contact, callType: CallType): Boolean {
+    val r = sendCmd(rh, CC.ApiSendCallInvitation(contact, callType))
     return r is CR.CmdOk
   }
 
-  suspend fun apiRejectCall(contact: Contact): Boolean {
-    val r = sendCmd(CC.ApiRejectCall(contact))
+  suspend fun apiRejectCall(rh: Long?, contact: Contact): Boolean {
+    val r = sendCmd(rh, CC.ApiRejectCall(contact))
     return r is CR.CmdOk
   }
 
-  suspend fun apiSendCallOffer(contact: Contact, rtcSession: String, rtcIceCandidates: String, media: CallMediaType, capabilities: CallCapabilities): Boolean {
+  suspend fun apiSendCallOffer(rh: Long?, contact: Contact, rtcSession: String, rtcIceCandidates: String, media: CallMediaType, capabilities: CallCapabilities): Boolean {
     val webRtcSession = WebRTCSession(rtcSession, rtcIceCandidates)
     val callOffer = WebRTCCallOffer(CallType(media, capabilities), webRtcSession)
-    val r = sendCmd(CC.ApiSendCallOffer(contact, callOffer))
+    val r = sendCmd(rh, CC.ApiSendCallOffer(contact, callOffer))
     return r is CR.CmdOk
   }
 
-  suspend fun apiSendCallAnswer(contact: Contact, rtcSession: String, rtcIceCandidates: String): Boolean {
+  suspend fun apiSendCallAnswer(rh: Long?, contact: Contact, rtcSession: String, rtcIceCandidates: String): Boolean {
     val answer = WebRTCSession(rtcSession, rtcIceCandidates)
-    val r = sendCmd(CC.ApiSendCallAnswer(contact, answer))
+    val r = sendCmd(rh, CC.ApiSendCallAnswer(contact, answer))
     return r is CR.CmdOk
   }
 
-  suspend fun apiSendCallExtraInfo(contact: Contact, rtcIceCandidates: String): Boolean {
+  suspend fun apiSendCallExtraInfo(rh: Long?, contact: Contact, rtcIceCandidates: String): Boolean {
     val extraInfo = WebRTCExtraInfo(rtcIceCandidates)
-    val r = sendCmd(CC.ApiSendCallExtraInfo(contact, extraInfo))
+    val r = sendCmd(rh, CC.ApiSendCallExtraInfo(contact, extraInfo))
     return r is CR.CmdOk
   }
 
-  suspend fun apiEndCall(contact: Contact): Boolean {
-    val r = sendCmd(CC.ApiEndCall(contact))
+  suspend fun apiEndCall(rh: Long?, contact: Contact): Boolean {
+    val r = sendCmd(rh, CC.ApiEndCall(contact))
     return r is CR.CmdOk
   }
 
-  suspend fun apiCallStatus(contact: Contact, status: WebRTCCallStatus): Boolean {
-    val r = sendCmd(CC.ApiCallStatus(contact, status))
+  suspend fun apiCallStatus(rh: Long?, contact: Contact, status: WebRTCCallStatus): Boolean {
+    val r = sendCmd(rh, CC.ApiCallStatus(contact, status))
     return r is CR.CmdOk
   }
 
-  suspend fun apiGetNetworkStatuses(): List<ConnNetworkStatus>? {
-    val r = sendCmd(CC.ApiGetNetworkStatuses())
+  suspend fun apiGetNetworkStatuses(rh: Long?): List<ConnNetworkStatus>? {
+    val r = sendCmd(rh, CC.ApiGetNetworkStatuses())
     if (r is CR.NetworkStatuses) return r.networkStatuses
     Log.e(TAG, "apiGetNetworkStatuses bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiChatRead(type: ChatType, id: Long, range: CC.ItemRange): Boolean {
-    val r = sendCmd(CC.ApiChatRead(type, id, range))
+  suspend fun apiChatRead(rh: Long?, type: ChatType, id: Long, range: CC.ItemRange): Boolean {
+    val r = sendCmd(rh, CC.ApiChatRead(type, id, range))
     if (r is CR.CmdOk) return true
     Log.e(TAG, "apiChatRead bad response: ${r.responseType} ${r.details}")
     return false
   }
 
-  suspend fun apiChatUnread(type: ChatType, id: Long, unreadChat: Boolean): Boolean {
-    val r = sendCmd(CC.ApiChatUnread(type, id, unreadChat))
+  suspend fun apiChatUnread(rh: Long?, type: ChatType, id: Long, unreadChat: Boolean): Boolean {
+    val r = sendCmd(rh, CC.ApiChatUnread(type, id, unreadChat))
     if (r is CR.CmdOk) return true
     Log.e(TAG, "apiChatUnread bad response: ${r.responseType} ${r.details}")
     return false
   }
 
-  suspend fun apiReceiveFile(rhId: Long?, fileId: Long, encrypted: Boolean, inline: Boolean? = null, auto: Boolean = false): AChatItem? {
+  suspend fun apiReceiveFile(rh: Long?, fileId: Long, encrypted: Boolean, inline: Boolean? = null, auto: Boolean = false): AChatItem? {
     // -1 here is to override default behavior of providing current remote host id because file can be asked by local device while remote is connected
-    val r = sendCmd(CC.ReceiveFile(fileId, encrypted, inline), rhId ?: -1)
+    val r = sendCmd(rh, CC.ReceiveFile(fileId, encrypted, inline))
     return when (r) {
       is CR.RcvFileAccepted -> r.chatItem
       is CR.RcvFileAcceptedSndCancelled -> {
@@ -1188,16 +1176,16 @@ object ChatController {
     }
   }
 
-  suspend fun cancelFile(rhId: Long?, user: User, fileId: Long) {
-    val chatItem = apiCancelFile(fileId)
+  suspend fun cancelFile(rh: Long?, user: User, fileId: Long) {
+    val chatItem = apiCancelFile(rh, fileId)
     if (chatItem != null) {
-      chatItemSimpleUpdate(rhId, user, chatItem)
+      chatItemSimpleUpdate(rh, user, chatItem)
       cleanupFile(chatItem)
     }
   }
 
-  suspend fun apiCancelFile(fileId: Long): AChatItem? {
-    val r = sendCmd(CC.CancelFile(fileId))
+  suspend fun apiCancelFile(rh: Long?, fileId: Long): AChatItem? {
+    val r = sendCmd(rh, CC.CancelFile(fileId))
     return when (r) {
       is CR.SndFileCancelled -> r.chatItem
       is CR.RcvFileCancelled -> r.chatItem
@@ -1208,16 +1196,16 @@ object ChatController {
     }
   }
 
-  suspend fun apiNewGroup(incognito: Boolean, groupProfile: GroupProfile): GroupInfo? {
+  suspend fun apiNewGroup(rh: Long?, incognito: Boolean, groupProfile: GroupProfile): GroupInfo? {
     val userId = kotlin.runCatching { currentUserId("apiNewGroup") }.getOrElse { return null }
-    val r = sendCmd(CC.ApiNewGroup(userId, incognito, groupProfile))
+    val r = sendCmd(rh, CC.ApiNewGroup(userId, incognito, groupProfile))
     if (r is CR.GroupCreated) return r.groupInfo
     Log.e(TAG, "apiNewGroup bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiAddMember(groupId: Long, contactId: Long, memberRole: GroupMemberRole): GroupMember? {
-    val r = sendCmd(CC.ApiAddMember(groupId, contactId, memberRole))
+  suspend fun apiAddMember(rh: Long?, groupId: Long, contactId: Long, memberRole: GroupMemberRole): GroupMember? {
+    val r = sendCmd(rh, CC.ApiAddMember(groupId, contactId, memberRole))
     return when (r) {
       is CR.SentGroupInvitation -> r.member
       else -> {
@@ -1229,14 +1217,14 @@ object ChatController {
     }
   }
 
-  suspend fun apiJoinGroup(groupId: Long) {
-    val r = sendCmd(CC.ApiJoinGroup(groupId))
+  suspend fun apiJoinGroup(rh: Long?, groupId: Long) {
+    val r = sendCmd(rh, CC.ApiJoinGroup(groupId))
     when (r) {
       is CR.UserAcceptedGroupSent ->
-        chatModel.updateGroup(r.groupInfo)
+        chatModel.updateGroup(rh, r.groupInfo)
       is CR.ChatCmdError -> {
         val e = r.chatError
-        suspend fun deleteGroup() { if (apiDeleteChat(ChatType.Group, groupId)) { chatModel.removeChat("#$groupId") } }
+        suspend fun deleteGroup() { if (apiDeleteChat(rh, ChatType.Group, groupId)) { chatModel.removeChat(rh, "#$groupId") } }
         if (e is ChatError.ChatErrorAgent && e.agentError is AgentErrorType.SMP && e.agentError.smpErr is SMPErrorType.AUTH) {
           deleteGroup()
           AlertManager.shared.showAlertMsg(generalGetString(MR.strings.alert_title_group_invitation_expired), generalGetString(MR.strings.alert_message_group_invitation_expired))
@@ -1251,8 +1239,8 @@ object ChatController {
     }
   }
 
-  suspend fun apiRemoveMember(groupId: Long, memberId: Long): GroupMember? =
-    when (val r = sendCmd(CC.ApiRemoveMember(groupId, memberId))) {
+  suspend fun apiRemoveMember(rh: Long?, groupId: Long, memberId: Long): GroupMember? =
+    when (val r = sendCmd(rh, CC.ApiRemoveMember(groupId, memberId))) {
       is CR.UserDeletedMember -> r.member
       else -> {
         if (!(networkErrorAlert(r))) {
@@ -1262,8 +1250,8 @@ object ChatController {
       }
     }
 
-  suspend fun apiMemberRole(groupId: Long, memberId: Long, memberRole: GroupMemberRole): GroupMember =
-    when (val r = sendCmd(CC.ApiMemberRole(groupId, memberId, memberRole))) {
+  suspend fun apiMemberRole(rh: Long?, groupId: Long, memberId: Long, memberRole: GroupMemberRole): GroupMember =
+    when (val r = sendCmd(rh, CC.ApiMemberRole(groupId, memberId, memberRole))) {
       is CR.MemberRoleUser -> r.member
       else -> {
         if (!(networkErrorAlert(r))) {
@@ -1273,22 +1261,22 @@ object ChatController {
       }
     }
 
-  suspend fun apiLeaveGroup(groupId: Long): GroupInfo? {
-    val r = sendCmd(CC.ApiLeaveGroup(groupId))
+  suspend fun apiLeaveGroup(rh: Long?, groupId: Long): GroupInfo? {
+    val r = sendCmd(rh, CC.ApiLeaveGroup(groupId))
     if (r is CR.LeftMemberUser) return r.groupInfo
     Log.e(TAG, "apiLeaveGroup bad response: ${r.responseType} ${r.details}")
     return null
   }
 
-  suspend fun apiListMembers(groupId: Long): List<GroupMember> {
-    val r = sendCmd(CC.ApiListMembers(groupId))
+  suspend fun apiListMembers(rh: Long?, groupId: Long): List<GroupMember> {
+    val r = sendCmd(rh, CC.ApiListMembers(groupId))
     if (r is CR.GroupMembers) return r.group.members
     Log.e(TAG, "apiListMembers bad response: ${r.responseType} ${r.details}")
     return emptyList()
   }
 
-  suspend fun apiUpdateGroup(groupId: Long, groupProfile: GroupProfile): GroupInfo? {
-    return when (val r = sendCmd(CC.ApiUpdateGroupProfile(groupId, groupProfile))) {
+  suspend fun apiUpdateGroup(rh: Long?, groupId: Long, groupProfile: GroupProfile): GroupInfo? {
+    return when (val r = sendCmd(rh, CC.ApiUpdateGroupProfile(groupId, groupProfile))) {
       is CR.GroupUpdated -> r.toGroup
       is CR.ChatCmdError -> {
         AlertManager.shared.showAlertMsg(generalGetString(MR.strings.error_saving_group_profile), "$r.chatError")
@@ -1305,8 +1293,8 @@ object ChatController {
     }
   }
 
-  suspend fun apiCreateGroupLink(groupId: Long, memberRole: GroupMemberRole = GroupMemberRole.Member): Pair<String, GroupMemberRole>? {
-    return when (val r = sendCmd(CC.APICreateGroupLink(groupId, memberRole))) {
+  suspend fun apiCreateGroupLink(rh: Long?, groupId: Long, memberRole: GroupMemberRole = GroupMemberRole.Member): Pair<String, GroupMemberRole>? {
+    return when (val r = sendCmd(rh, CC.APICreateGroupLink(groupId, memberRole))) {
       is CR.GroupLinkCreated -> r.connReqContact to r.memberRole
       else -> {
         if (!(networkErrorAlert(r))) {
@@ -1317,8 +1305,8 @@ object ChatController {
     }
   }
 
-  suspend fun apiGroupLinkMemberRole(groupId: Long, memberRole: GroupMemberRole = GroupMemberRole.Member): Pair<String, GroupMemberRole>? {
-    return when (val r = sendCmd(CC.APIGroupLinkMemberRole(groupId, memberRole))) {
+  suspend fun apiGroupLinkMemberRole(rh: Long?, groupId: Long, memberRole: GroupMemberRole = GroupMemberRole.Member): Pair<String, GroupMemberRole>? {
+    return when (val r = sendCmd(rh, CC.APIGroupLinkMemberRole(groupId, memberRole))) {
       is CR.GroupLink -> r.connReqContact to r.memberRole
       else -> {
         if (!(networkErrorAlert(r))) {
@@ -1329,8 +1317,8 @@ object ChatController {
     }
   }
 
-  suspend fun apiDeleteGroupLink(groupId: Long): Boolean {
-    return when (val r = sendCmd(CC.APIDeleteGroupLink(groupId))) {
+  suspend fun apiDeleteGroupLink(rh: Long?, groupId: Long): Boolean {
+    return when (val r = sendCmd(rh, CC.APIDeleteGroupLink(groupId))) {
       is CR.GroupLinkDeleted -> true
       else -> {
         if (!(networkErrorAlert(r))) {
@@ -1341,8 +1329,8 @@ object ChatController {
     }
   }
 
-  suspend fun apiGetGroupLink(groupId: Long): Pair<String, GroupMemberRole>? {
-    return when (val r = sendCmd(CC.APIGetGroupLink(groupId))) {
+  suspend fun apiGetGroupLink(rh: Long?, groupId: Long): Pair<String, GroupMemberRole>? {
+    return when (val r = sendCmd(rh, CC.APIGetGroupLink(groupId))) {
       is CR.GroupLink -> r.connReqContact to r.memberRole
       else -> {
         Log.e(TAG, "apiGetGroupLink bad response: ${r.responseType} ${r.details}")
@@ -1351,8 +1339,8 @@ object ChatController {
     }
   }
 
-  suspend fun apiCreateMemberContact(groupId: Long, groupMemberId: Long): Contact? {
-    return when (val r = sendCmd(CC.APICreateMemberContact(groupId, groupMemberId))) {
+  suspend fun apiCreateMemberContact(rh: Long?, groupId: Long, groupMemberId: Long): Contact? {
+    return when (val r = sendCmd(rh, CC.APICreateMemberContact(groupId, groupMemberId))) {
       is CR.NewMemberContact -> r.contact
       else -> {
         if (!(networkErrorAlert(r))) {
@@ -1363,8 +1351,8 @@ object ChatController {
     }
   }
 
-  suspend fun apiSendMemberContactInvitation(contactId: Long, mc: MsgContent): Contact? {
-    return when (val r = sendCmd(CC.APISendMemberContactInvitation(contactId, mc))) {
+  suspend fun apiSendMemberContactInvitation(rh: Long?, contactId: Long, mc: MsgContent): Contact? {
+    return when (val r = sendCmd(rh, CC.APISendMemberContactInvitation(contactId, mc))) {
       is CR.NewMemberContactSentInv -> r.contact
       else -> {
         if (!(networkErrorAlert(r))) {
@@ -1375,18 +1363,18 @@ object ChatController {
     }
   }
 
-  suspend fun allowFeatureToContact(contact: Contact, feature: ChatFeature, param: Int? = null) {
+  suspend fun allowFeatureToContact(rh: Long?, contact: Contact, feature: ChatFeature, param: Int? = null) {
     val prefs = contact.mergedPreferences.toPreferences().setAllowed(feature, param = param)
-    val toContact = apiSetContactPrefs(contact.contactId, prefs)
+    val toContact = apiSetContactPrefs(rh, contact.contactId, prefs)
     if (toContact != null) {
-      chatModel.updateContact(toContact)
+      chatModel.updateContact(rh, toContact)
     }
   }
 
-  suspend fun setLocalDeviceName(displayName: String): Boolean = sendCommandOkResp(CC.SetLocalDeviceName(displayName))
+  suspend fun setLocalDeviceName(displayName: String): Boolean = sendCommandOkResp(null, CC.SetLocalDeviceName(displayName))
 
   suspend fun listRemoteHosts(): List<RemoteHostInfo>? {
-    val r = sendCmd(CC.ListRemoteHosts())
+    val r = sendCmd(null, CC.ListRemoteHosts())
     if (r is CR.RemoteHostList) return r.remoteHosts
     apiErrorAlert("listRemoteHosts", generalGetString(MR.strings.error_alert_title), r)
     return null
@@ -1399,20 +1387,20 @@ object ChatController {
   }
 
   suspend fun startRemoteHost(rhId: Long?, multicast: Boolean = false): Pair<RemoteHostInfo?, String>? {
-    val r = sendCmd(CC.StartRemoteHost(rhId, multicast))
+    val r = sendCmd(null, CC.StartRemoteHost(rhId, multicast))
     if (r is CR.RemoteHostStarted) return r.remoteHost_ to r.invitation
     apiErrorAlert("listRemoteHosts", generalGetString(MR.strings.error_alert_title), r)
     return null
   }
 
   suspend fun switchRemoteHost (rhId: Long?): RemoteHostInfo? {
-    val r = sendCmd(CC.SwitchRemoteHost(rhId))
+    val r = sendCmd(null, CC.SwitchRemoteHost(rhId))
     if (r is CR.CurrentRemoteHost) return r.remoteHost_
     apiErrorAlert("switchRemoteHost", generalGetString(MR.strings.error_alert_title), r)
     return null
   }
 
-  suspend fun stopRemoteHost(rhId: Long?): Boolean = sendCommandOkResp(CC.StopRemoteHost(rhId))
+  suspend fun stopRemoteHost(rhId: Long?): Boolean = sendCommandOkResp(null, CC.StopRemoteHost(rhId))
 
   fun stopRemoteHostAndReloadHosts(h: RemoteHostInfo, switchToLocal: Boolean) {
     withBGApi {
@@ -1425,55 +1413,55 @@ object ChatController {
     }
   }
 
-  suspend fun deleteRemoteHost(rhId: Long): Boolean = sendCommandOkResp(CC.DeleteRemoteHost(rhId))
+  suspend fun deleteRemoteHost(rhId: Long): Boolean = sendCommandOkResp(null, CC.DeleteRemoteHost(rhId))
 
   suspend fun storeRemoteFile(rhId: Long, storeEncrypted: Boolean?, localPath: String): CryptoFile? {
-    val r = sendCmd(CC.StoreRemoteFile(rhId, storeEncrypted, localPath))
+    val r = sendCmd(null, CC.StoreRemoteFile(rhId, storeEncrypted, localPath))
     if (r is CR.RemoteFileStored) return r.remoteFileSource
     apiErrorAlert("storeRemoteFile", generalGetString(MR.strings.error_alert_title), r)
     return null
   }
 
-  suspend fun getRemoteFile(rhId: Long, file: RemoteFile): Boolean = sendCommandOkResp(CC.GetRemoteFile(rhId, file))
+  suspend fun getRemoteFile(rhId: Long, file: RemoteFile): Boolean = sendCommandOkResp(null, CC.GetRemoteFile(rhId, file))
 
   suspend fun connectRemoteCtrl(desktopAddress: String): Pair<SomeRemoteCtrl?, CR.ChatCmdError?> {
-    val r = sendCmd(CC.ConnectRemoteCtrl(desktopAddress))
+    val r = sendCmd(null, CC.ConnectRemoteCtrl(desktopAddress))
     if (r is CR.RemoteCtrlConnecting) return SomeRemoteCtrl(r.remoteCtrl_, r.ctrlAppInfo, r.appVersion) to null
     else if (r is CR.ChatCmdError) return null to r
     else throw Exception("connectRemoteCtrl error: ${r.responseType} ${r.details}")
   }
 
-  suspend fun findKnownRemoteCtrl(): Boolean = sendCommandOkResp(CC.FindKnownRemoteCtrl())
+  suspend fun findKnownRemoteCtrl(): Boolean = sendCommandOkResp(null, CC.FindKnownRemoteCtrl())
 
-  suspend fun confirmRemoteCtrl(rcId: Long): Boolean = sendCommandOkResp(CC.ConfirmRemoteCtrl(rcId))
+  suspend fun confirmRemoteCtrl(rcId: Long): Boolean = sendCommandOkResp(null, CC.ConfirmRemoteCtrl(rcId))
 
   suspend fun verifyRemoteCtrlSession(sessionCode: String): RemoteCtrlInfo? {
-    val r = sendCmd(CC.VerifyRemoteCtrlSession(sessionCode))
+    val r = sendCmd(null, CC.VerifyRemoteCtrlSession(sessionCode))
     if (r is CR.RemoteCtrlConnected) return r.remoteCtrl
     apiErrorAlert("verifyRemoteCtrlSession", generalGetString(MR.strings.error_alert_title), r)
     return null
   }
 
   suspend fun listRemoteCtrls(): List<RemoteCtrlInfo>? {
-    val r = sendCmd(CC.ListRemoteCtrls())
+    val r = sendCmd(null, CC.ListRemoteCtrls())
     if (r is CR.RemoteCtrlList) return r.remoteCtrls
     apiErrorAlert("listRemoteCtrls", generalGetString(MR.strings.error_alert_title), r)
     return null
   }
 
-  suspend fun stopRemoteCtrl(): Boolean = sendCommandOkResp(CC.StopRemoteCtrl())
+  suspend fun stopRemoteCtrl(): Boolean = sendCommandOkResp(null, CC.StopRemoteCtrl())
 
-  suspend fun deleteRemoteCtrl(rcId: Long): Boolean = sendCommandOkResp(CC.DeleteRemoteCtrl(rcId))
+  suspend fun deleteRemoteCtrl(rcId: Long): Boolean = sendCommandOkResp(null, CC.DeleteRemoteCtrl(rcId))
 
-  private suspend fun sendCommandOkResp(cmd: CC): Boolean {
-    val r = sendCmd(cmd)
+  private suspend fun sendCommandOkResp(rh: Long?, cmd: CC): Boolean {
+    val r = sendCmd(rh, cmd)
     val ok = r is CR.CmdOk
     if (!ok) apiErrorAlert(cmd.cmdType, generalGetString(MR.strings.error_alert_title), r)
     return ok
   }
 
   suspend fun apiGetVersion(): CoreVersionInfo? {
-    val r = sendCmd(CC.ShowVersion())
+    val r = sendCmd(null, CC.ShowVersion())
     return if (r is CR.VersionInfo) {
       r.versionInfo
     } else {
@@ -1517,30 +1505,30 @@ object ChatController {
     val r = apiResp.resp
     val rhId = apiResp.remoteHostId
     fun active(user: UserLike): Boolean = activeUser(rhId, user)
-    chatModel.addTerminalItem(TerminalItem.resp(r))
+    chatModel.addTerminalItem(TerminalItem.resp(rhId, r))
     when (r) {
       is CR.NewContactConnection -> {
         if (active(r.user)) {
-          chatModel.updateContactConnection(r.connection)
+          chatModel.updateContactConnection(rhId, r.connection)
         }
       }
       is CR.ContactConnectionDeleted -> {
         if (active(r.user)) {
-          chatModel.removeChat(r.connection.id)
+          chatModel.removeChat(rhId, r.connection.id)
         }
       }
       is CR.ContactDeletedByContact -> {
         if (active(r.user) && r.contact.directOrUsed) {
-          chatModel.updateContact(r.contact)
+          chatModel.updateContact(rhId, r.contact)
         }
       }
       is CR.ContactConnected -> {
         if (active(r.user) && r.contact.directOrUsed) {
-          chatModel.updateContact(r.contact)
+          chatModel.updateContact(rhId, r.contact)
           val conn = r.contact.activeConn
           if (conn != null) {
             chatModel.dismissConnReqView(conn.id)
-            chatModel.removeChat(conn.id)
+            chatModel.removeChat(rhId, conn.id)
           }
         }
         if (r.contact.directOrUsed) {
@@ -1550,11 +1538,11 @@ object ChatController {
       }
       is CR.ContactConnecting -> {
         if (active(r.user) && r.contact.directOrUsed) {
-          chatModel.updateContact(r.contact)
+          chatModel.updateContact(rhId, r.contact)
           val conn = r.contact.activeConn
           if (conn != null) {
             chatModel.dismissConnReqView(conn.id)
-            chatModel.removeChat(conn.id)
+            chatModel.removeChat(rhId, conn.id)
           }
         }
       }
@@ -1562,31 +1550,31 @@ object ChatController {
         val contactRequest = r.contactRequest
         val cInfo = ChatInfo.ContactRequest(contactRequest)
         if (active(r.user)) {
-          if (chatModel.hasChat(contactRequest.id)) {
-            chatModel.updateChatInfo(cInfo)
+          if (chatModel.hasChat(rhId, contactRequest.id)) {
+            chatModel.updateChatInfo(rhId, cInfo)
           } else {
-            chatModel.addChat(Chat(chatInfo = cInfo, chatItems = listOf()))
+            chatModel.addChat(Chat(remoteHostId = rhId, chatInfo = cInfo, chatItems = listOf()))
           }
         }
         ntfManager.notifyContactRequestReceived(r.user, cInfo)
       }
       is CR.ContactUpdated -> {
-        if (active(r.user) && chatModel.hasChat(r.toContact.id)) {
+        if (active(r.user) && chatModel.hasChat(rhId, r.toContact.id)) {
           val cInfo = ChatInfo.Direct(r.toContact)
-          chatModel.updateChatInfo(cInfo)
+          chatModel.updateChatInfo(rhId, cInfo)
         }
       }
       is CR.GroupMemberUpdated -> {
         if (active(r.user)) {
-          chatModel.upsertGroupMember(r.groupInfo, r.toMember)
+          chatModel.upsertGroupMember(rhId, r.groupInfo, r.toMember)
         }
       }
       is CR.ContactsMerged -> {
-        if (active(r.user) && chatModel.hasChat(r.mergedContact.id)) {
+        if (active(r.user) && chatModel.hasChat(rhId, r.mergedContact.id)) {
           if (chatModel.chatId.value == r.mergedContact.id) {
             chatModel.chatId.value = r.intoContact.id
           }
-          chatModel.removeChat(r.mergedContact.id)
+          chatModel.removeChat(rhId, r.mergedContact.id)
         }
       }
       is CR.ContactsSubscribed -> updateContactsStatus(r.contactRefs, NetworkStatus.Connected())
@@ -1594,7 +1582,7 @@ object ChatController {
       is CR.ContactSubSummary -> {
         for (sub in r.contactSubscriptions) {
           if (active(r.user)) {
-            chatModel.updateContact(sub.contact)
+            chatModel.updateContact(rhId, sub.contact)
           }
           val err = sub.contactError
           if (err == null) {
@@ -1618,9 +1606,9 @@ object ChatController {
         val cInfo = r.chatItem.chatInfo
         val cItem = r.chatItem.chatItem
         if (active(r.user)) {
-          chatModel.addChatItem(cInfo, cItem)
+          chatModel.addChatItem(rhId, cInfo, cItem)
         } else if (cItem.isRcvNew && cInfo.ntfsEnabled) {
-          chatModel.increaseUnreadCounter(r.user)
+          chatModel.increaseUnreadCounter(rhId, r.user)
         }
         val file = cItem.file
         val mc = cItem.content.msgContent
@@ -1631,7 +1619,7 @@ object ChatController {
                 || (mc is MsgContent.MCVoice && file.fileSize <= MAX_VOICE_SIZE_AUTO_RCV && file.fileStatus !is CIFileStatus.RcvAccepted))) {
           withApi { receiveFile(rhId, r.user, file.fileId, encrypted = cItem.encryptLocalFile && chatController.appPrefs.privacyEncryptLocalFiles.get(), auto = true) }
         }
-        if (cItem.showNotification && (allowedToShowNotification() || chatModel.chatId.value != cInfo.id)) {
+        if (cItem.showNotification && (allowedToShowNotification() || chatModel.chatId.value != cInfo.id || chatModel.remoteHostId != rhId)) {
           ntfManager.notifyMessageReceived(r.user, cInfo, cItem)
         }
       }
@@ -1652,7 +1640,7 @@ object ChatController {
       is CR.ChatItemDeleted -> {
         if (!active(r.user)) {
           if (r.toChatItem == null && r.deletedChatItem.chatItem.isRcvNew && r.deletedChatItem.chatInfo.ntfsEnabled) {
-            chatModel.decreaseUnreadCounter(r.user)
+            chatModel.decreaseUnreadCounter(rhId, r.user)
           }
           return
         }
@@ -1671,76 +1659,76 @@ object ChatController {
           )
         }
         if (r.toChatItem == null) {
-          chatModel.removeChatItem(cInfo, cItem)
+          chatModel.removeChatItem(rhId, cInfo, cItem)
         } else {
-          chatModel.upsertChatItem(cInfo, r.toChatItem.chatItem)
+          chatModel.upsertChatItem(rhId, cInfo, r.toChatItem.chatItem)
         }
       }
       is CR.ReceivedGroupInvitation -> {
         if (active(r.user)) {
-          chatModel.updateGroup(r.groupInfo) // update so that repeat group invitations are not duplicated
+          chatModel.updateGroup(rhId, r.groupInfo) // update so that repeat group invitations are not duplicated
           // TODO NtfManager.shared.notifyGroupInvitation
         }
       }
       is CR.UserAcceptedGroupSent -> {
         if (!active(r.user)) return
 
-        chatModel.updateGroup(r.groupInfo)
+        chatModel.updateGroup(rhId, r.groupInfo)
         val conn = r.hostContact?.activeConn
         if (conn != null) {
           chatModel.dismissConnReqView(conn.id)
-          chatModel.removeChat(conn.id)
+          chatModel.removeChat(rhId, conn.id)
         }
       }
       is CR.GroupLinkConnecting -> {
         if (!active(r.user)) return
 
-        chatModel.updateGroup(r.groupInfo)
+        chatModel.updateGroup(rhId, r.groupInfo)
         val hostConn = r.hostMember.activeConn
         if (hostConn != null) {
           chatModel.dismissConnReqView(hostConn.id)
-          chatModel.removeChat(hostConn.id)
+          chatModel.removeChat(rhId, hostConn.id)
         }
       }
       is CR.JoinedGroupMemberConnecting ->
         if (active(r.user)) {
-          chatModel.upsertGroupMember(r.groupInfo, r.member)
+          chatModel.upsertGroupMember(rhId, r.groupInfo, r.member)
         }
       is CR.DeletedMemberUser -> // TODO update user member
         if (active(r.user)) {
-          chatModel.updateGroup(r.groupInfo)
+          chatModel.updateGroup(rhId, r.groupInfo)
         }
       is CR.DeletedMember ->
         if (active(r.user)) {
-          chatModel.upsertGroupMember(r.groupInfo, r.deletedMember)
+          chatModel.upsertGroupMember(rhId, r.groupInfo, r.deletedMember)
         }
       is CR.LeftMember ->
         if (active(r.user)) {
-          chatModel.upsertGroupMember(r.groupInfo, r.member)
+          chatModel.upsertGroupMember(rhId, r.groupInfo, r.member)
         }
       is CR.MemberRole ->
         if (active(r.user)) {
-          chatModel.upsertGroupMember(r.groupInfo, r.member)
+          chatModel.upsertGroupMember(rhId, r.groupInfo, r.member)
         }
       is CR.MemberRoleUser ->
         if (active(r.user)) {
-          chatModel.upsertGroupMember(r.groupInfo, r.member)
+          chatModel.upsertGroupMember(rhId, r.groupInfo, r.member)
         }
       is CR.GroupDeleted -> // TODO update user member
         if (active(r.user)) {
-          chatModel.updateGroup(r.groupInfo)
+          chatModel.updateGroup(rhId, r.groupInfo)
         }
       is CR.UserJoinedGroup ->
         if (active(r.user)) {
-          chatModel.updateGroup(r.groupInfo)
+          chatModel.updateGroup(rhId, r.groupInfo)
         }
       is CR.JoinedGroupMember ->
         if (active(r.user)) {
-          chatModel.upsertGroupMember(r.groupInfo, r.member)
+          chatModel.upsertGroupMember(rhId, r.groupInfo, r.member)
         }
       is CR.ConnectedToGroupMember -> {
         if (active(r.user)) {
-          chatModel.upsertGroupMember(r.groupInfo, r.member)
+          chatModel.upsertGroupMember(rhId, r.groupInfo, r.member)
         }
         if (r.memberContact != null) {
           chatModel.setContactNetworkStatus(r.memberContact, NetworkStatus.Connected())
@@ -1748,11 +1736,11 @@ object ChatController {
       }
       is CR.GroupUpdated ->
         if (active(r.user)) {
-          chatModel.updateGroup(r.toGroup)
+          chatModel.updateGroup(rhId, r.toGroup)
         }
       is CR.NewMemberContactReceivedInv ->
         if (active(r.user)) {
-          chatModel.updateContact(r.contact)
+          chatModel.updateContact(rhId, r.contact)
         }
       is CR.RcvFileStart ->
         chatItemSimpleUpdate(rhId, r.user, r.chatItem)
@@ -1789,7 +1777,7 @@ object ChatController {
         cleanupFile(r.chatItem)
       }
       is CR.CallInvitation -> {
-        chatModel.callManager.reportNewIncomingCall(r.callInvitation)
+        chatModel.callManager.reportNewIncomingCall(r.callInvitation.copy(remoteHostId = rhId))
       }
       is CR.CallOffer -> {
         // TODO askConfirmation?
@@ -1834,13 +1822,13 @@ object ChatController {
         }
       }
       is CR.ContactSwitch ->
-        chatModel.updateContactConnectionStats(r.contact, r.switchProgress.connectionStats)
+        chatModel.updateContactConnectionStats(rhId, r.contact, r.switchProgress.connectionStats)
       is CR.GroupMemberSwitch ->
-        chatModel.updateGroupMemberConnectionStats(r.groupInfo, r.member, r.switchProgress.connectionStats)
+        chatModel.updateGroupMemberConnectionStats(rhId, r.groupInfo, r.member, r.switchProgress.connectionStats)
       is CR.ContactRatchetSync ->
-        chatModel.updateContactConnectionStats(r.contact, r.ratchetSyncProgress.connectionStats)
+        chatModel.updateContactConnectionStats(rhId, r.contact, r.ratchetSyncProgress.connectionStats)
       is CR.GroupMemberRatchetSync ->
-        chatModel.updateGroupMemberConnectionStats(r.groupInfo, r.member, r.ratchetSyncProgress.connectionStats)
+        chatModel.updateGroupMemberConnectionStats(rhId, r.groupInfo, r.member, r.ratchetSyncProgress.connectionStats)
       is CR.RemoteHostSessionCode -> {
         chatModel.newRemoteHostPairing.value = r.remoteHost_ to RemoteHostSessionState.PendingConfirmation(r.sessionCode)
       }
@@ -1850,9 +1838,11 @@ object ChatController {
         switchUIRemoteHost(r.remoteHost.remoteHostId)
       }
       is CR.RemoteHostStopped -> {
-        chatModel.currentRemoteHost.value = null
         chatModel.newRemoteHostPairing.value = null
-        switchUIRemoteHost(null)
+        if (chatModel.currentRemoteHost.value != null) {
+          chatModel.currentRemoteHost.value = null
+          switchUIRemoteHost(null)
+        }
       }
       is CR.RemoteCtrlFound -> {
         // TODO multicast
@@ -1897,11 +1887,11 @@ object ChatController {
     val m = chatModel
     m.remoteCtrlSession.value = null
     withBGApi {
-      val users = listUsers()
+      val users = listUsers(null)
       m.users.clear()
       m.users.addAll(users)
-      getUserChatData()
-      val statuses = apiGetNetworkStatuses()
+      getUserChatData(null)
+      val statuses = apiGetNetworkStatuses(null)
       if (statuses != null) {
         chatModel.networkStatuses.clear()
         val ss = statuses.associate { it.agentConnId to it.networkStatus }.toMap()
@@ -1911,7 +1901,7 @@ object ChatController {
   }
 
   private fun activeUser(rhId: Long?, user: UserLike): Boolean =
-    rhId == chatModel.currentRemoteHost.value?.remoteHostId && user.userId == chatModel.currentUser.value?.userId
+    rhId == chatModel.remoteHostId && user.userId == chatModel.currentUser.value?.userId
 
   private fun withCall(r: CR, contact: Contact, perform: (Call) -> Unit) {
     val call = chatModel.activeCall.value
@@ -1929,20 +1919,20 @@ object ChatController {
     }
   }
 
-  suspend fun leaveGroup(groupId: Long) {
-    val groupInfo = apiLeaveGroup(groupId)
+  suspend fun leaveGroup(rh: Long?, groupId: Long) {
+    val groupInfo = apiLeaveGroup(rh, groupId)
     if (groupInfo != null) {
-      chatModel.updateGroup(groupInfo)
+      chatModel.updateGroup(rh, groupInfo)
     }
   }
 
-  private suspend fun chatItemSimpleUpdate(rhId: Long?, user: UserLike, aChatItem: AChatItem) {
+  private suspend fun chatItemSimpleUpdate(rh: Long?, user: UserLike, aChatItem: AChatItem) {
     val cInfo = aChatItem.chatInfo
     val cItem = aChatItem.chatItem
     val notify = { ntfManager.notifyMessageReceived(user, cInfo, cItem) }
-    if (!activeUser(rhId, user)) {
+    if (!activeUser(rh, user)) {
       notify()
-    } else if (chatModel.upsertChatItem(cInfo, cItem)) {
+    } else if (chatModel.upsertChatItem(rh, cInfo, cItem)) {
       notify()
     }
   }
@@ -1969,22 +1959,23 @@ object ChatController {
   }
 
   suspend fun switchUIRemoteHost(rhId: Long?) {
+    // TODO lock the switch so that two switches can't run concurrently?
     chatModel.chatId.value = null
     chatModel.currentRemoteHost.value = switchRemoteHost(rhId)
     reloadRemoteHosts()
-    val user = apiGetActiveUser()
-    val users = listUsers()
+    val user = apiGetActiveUser(rhId)
+    val users = listUsers(rhId)
     chatModel.users.clear()
     chatModel.users.addAll(users)
     chatModel.currentUser.value = user
     chatModel.userCreated.value = true
-    val statuses = apiGetNetworkStatuses()
+    val statuses = apiGetNetworkStatuses(rhId)
     if (statuses != null) {
       chatModel.networkStatuses.clear()
       val ss = statuses.associate { it.agentConnId to it.networkStatus }.toMap()
       chatModel.networkStatuses.putAll(ss)
     }
-    getUserChatData()
+    getUserChatData(rhId)
   }
 
   fun getXFTPCfg(): XFTPFileConfig {
@@ -2540,6 +2531,7 @@ data class UserProtocolServers(
 
 @Serializable
 data class ServerCfg(
+  val remoteHostId: Long? = null,
   val server: String,
   val preset: Boolean,
   val tested: Boolean? = null,
@@ -3610,7 +3602,7 @@ private fun parseChatData(chat: JsonElement): Chat {
   val chatItems: List<ChatItem> = chat.jsonObject["chatItems"]!!.jsonArray.map {
     decodeObject(ChatItem.serializer(), it) ?: parseChatItem(it)
   }
-  return Chat(chatInfo, chatItems, chatStats)
+  return Chat(remoteHostId = null, chatInfo, chatItems, chatStats)
 }
 
 private fun parseChatItem(j: JsonElement): ChatItem {
@@ -3699,7 +3691,6 @@ sealed class CR {
   @Serializable @SerialName("chatItemNotChanged") class ChatItemNotChanged(val user: UserRef, val chatItem: AChatItem): CR()
   @Serializable @SerialName("chatItemReaction") class ChatItemReaction(val user: UserRef, val added: Boolean, val reaction: ACIReaction): CR()
   @Serializable @SerialName("chatItemDeleted") class ChatItemDeleted(val user: UserRef, val deletedChatItem: AChatItem, val toChatItem: AChatItem? = null, val byUser: Boolean): CR()
-  @Serializable @SerialName("contactsList") class ContactsList(val user: UserRef, val contacts: List<Contact>): CR()
   // group events
   @Serializable @SerialName("groupCreated") class GroupCreated(val user: UserRef, val groupInfo: GroupInfo): CR()
   @Serializable @SerialName("sentGroupInvitation") class SentGroupInvitation(val user: UserRef, val groupInfo: GroupInfo, val contact: Contact, val member: GroupMember): CR()
@@ -3853,7 +3844,6 @@ sealed class CR {
     is ChatItemNotChanged -> "chatItemNotChanged"
     is ChatItemReaction -> "chatItemReaction"
     is ChatItemDeleted -> "chatItemDeleted"
-    is ContactsList -> "contactsList"
     is GroupCreated -> "groupCreated"
     is SentGroupInvitation -> "sentGroupInvitation"
     is UserAcceptedGroupSent -> "userAcceptedGroupSent"
@@ -4001,7 +3991,6 @@ sealed class CR {
     is ChatItemNotChanged -> withUser(user, json.encodeToString(chatItem))
     is ChatItemReaction -> withUser(user, "added: $added\n${json.encodeToString(reaction)}")
     is ChatItemDeleted -> withUser(user, "deletedChatItem:\n${json.encodeToString(deletedChatItem)}\ntoChatItem:\n${json.encodeToString(toChatItem)}\nbyUser: $byUser")
-    is ContactsList -> withUser(user, json.encodeToString(contacts))
     is GroupCreated -> withUser(user, json.encodeToString(groupInfo))
     is SentGroupInvitation -> withUser(user, "groupInfo: $groupInfo\ncontact: $contact\nmember: $member")
     is UserAcceptedGroupSent -> json.encodeToString(groupInfo)
@@ -4138,28 +4127,29 @@ sealed class GroupLinkPlan {
 
 abstract class TerminalItem {
   abstract val id: Long
+  abstract val remoteHostId: Long?
   val date: Instant = Clock.System.now()
   abstract val label: String
   abstract val details: String
 
-  class Cmd(override val id: Long, val cmd: CC): TerminalItem() {
+  class Cmd(override val id: Long, override val remoteHostId: Long?, val cmd: CC): TerminalItem() {
     override val label get() = "> ${cmd.cmdString}"
     override val details get() = cmd.cmdString
   }
 
-  class Resp(override val id: Long, val resp: CR): TerminalItem() {
+  class Resp(override val id: Long, override val remoteHostId: Long?, val resp: CR): TerminalItem() {
     override val label get() = "< ${resp.responseType}"
     override val details get() = resp.details
   }
 
   companion object {
     val sampleData = listOf(
-        Cmd(0, CC.ShowActiveUser()),
-        Resp(1, CR.ActiveUser(User.sampleData))
+        Cmd(0, null, CC.ShowActiveUser()),
+        Resp(1, null, CR.ActiveUser(User.sampleData))
     )
 
-    fun cmd(c: CC) = Cmd(System.currentTimeMillis(), c)
-    fun resp(r: CR) = Resp(System.currentTimeMillis(), r)
+    fun cmd(rhId: Long?, c: CC) = Cmd(System.currentTimeMillis(), rhId, c)
+    fun resp(rhId: Long?, r: CR) = Resp(System.currentTimeMillis(), rhId, r)
   }
 }
 
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt
index c32137ee6..3d3a91cb3 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt
@@ -53,7 +53,7 @@ suspend fun initChatController(useKey: String? = null, confirmMigrations: Migrat
   } else if (startChat) {
     // If we migrated successfully means previous re-encryption process on database level finished successfully too
     if (appPreferences.encryptionStartedAt.get() != null) appPreferences.encryptionStartedAt.set(null)
-    val user = chatController.apiGetActiveUser()
+    val user = chatController.apiGetActiveUser(null)
     if (user == null) {
       chatModel.controller.appPrefs.onboardingStage.set(OnboardingStage.Step1_SimpleXInfo)
       chatModel.controller.appPrefs.privacyDeliveryReceiptsSet.set(true)
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/NtfManager.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/NtfManager.kt
index a03df5add..06925e28a 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/NtfManager.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/NtfManager.kt
@@ -49,7 +49,8 @@ abstract class NtfManager {
       null
     }
     val apiId = chatId.replace("<@", "").toLongOrNull() ?: return
-    acceptContactRequest(incognito, apiId, cInfo, isCurrentUser, ChatModel)
+    // TODO include remote host in notification
+    acceptContactRequest(null, incognito, apiId, cInfo, isCurrentUser, ChatModel)
     cancelNotificationsForChat(chatId)
   }
 
@@ -57,11 +58,12 @@ abstract class NtfManager {
     withBGApi {
       awaitChatStartedIfNeeded(chatModel)
       if (userId != null && userId != chatModel.currentUser.value?.userId && chatModel.currentUser.value != null) {
-        chatModel.controller.changeActiveUser(userId, null)
+        // TODO include remote host ID in desktop notifications?
+        chatModel.controller.changeActiveUser(null, userId, null)
       }
       val cInfo = chatModel.getChat(chatId)?.chatInfo
       chatModel.clearOverlays.value = true
-      if (cInfo != null && (cInfo is ChatInfo.Direct || cInfo is ChatInfo.Group)) openChat(cInfo, chatModel)
+      if (cInfo != null && (cInfo is ChatInfo.Direct || cInfo is ChatInfo.Group)) openChat(null, cInfo, chatModel)
     }
   }
 
@@ -69,7 +71,8 @@ abstract class NtfManager {
     withBGApi {
       awaitChatStartedIfNeeded(chatModel)
       if (userId != null && userId != chatModel.currentUser.value?.userId && chatModel.currentUser.value != null) {
-        chatModel.controller.changeActiveUser(userId, null)
+        // TODO include remote host ID in desktop notifications?
+        chatModel.controller.changeActiveUser(null, userId, null)
       }
       chatModel.chatId.value = null
       chatModel.clearOverlays.value = true
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/TerminalView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/TerminalView.kt
index a471b5645..ec2082557 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/TerminalView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/TerminalView.kt
@@ -47,13 +47,14 @@ private fun sendCommand(chatModel: ChatModel, composeState: MutableState<Compose
   val s = composeState.value.message
   if (s.startsWith("/sql") && (!prefPerformLA || !developerTools)) {
     val resp = CR.ChatCmdError(null, ChatError.ChatErrorChat(ChatErrorType.CommandError("Failed reading: empty")))
-    chatModel.addTerminalItem(TerminalItem.cmd(CC.Console(s)))
-    chatModel.addTerminalItem(TerminalItem.resp(resp))
+    chatModel.addTerminalItem(TerminalItem.cmd(null, CC.Console(s)))
+    chatModel.addTerminalItem(TerminalItem.resp(null, resp))
     composeState.value = ComposeState(useLinkPreviews = false)
   } else {
     withApi {
       // show "in progress"
-      chatModel.controller.sendCmd(CC.Console(s))
+      // TODO show active remote host in chat console?
+      chatModel.controller.sendCmd(chatModel.remoteHostId, CC.Console(s))
       composeState.value = ComposeState(useLinkPreviews = false)
       // hide "in progress"
     }
@@ -139,8 +140,10 @@ fun TerminalLog(terminalItems: List<TerminalItem>) {
   val clipboard = LocalClipboardManager.current
   LazyColumn(state = listState, reverseLayout = true) {
     items(reversedTerminalItems) { item ->
+      val rhId = item.remoteHostId
+      val rhIdStr = if (rhId == null) "" else "$rhId "
       Text(
-        "${item.date.toString().subSequence(11, 19)} ${item.label}",
+        "$rhIdStr${item.date.toString().subSequence(11, 19)} ${item.label}",
         style = TextStyle(fontFamily = FontFamily.Monospace, fontSize = 18.sp, color = MaterialTheme.colors.primary),
         maxLines = 1,
         overflow = TextOverflow.Ellipsis,
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/WelcomeView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/WelcomeView.kt
index 504ecac89..fb15f0aba 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/WelcomeView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/WelcomeView.kt
@@ -170,18 +170,19 @@ fun CreateFirstProfile(chatModel: ChatModel, close: () -> Unit) {
 
 fun createProfileInProfiles(chatModel: ChatModel, displayName: String, close: () -> Unit) {
   withApi {
+    val rhId = chatModel.remoteHostId
     val user = chatModel.controller.apiCreateActiveUser(
-      Profile(displayName.trim(), "", null)
+      rhId, Profile(displayName.trim(), "", null)
     ) ?: return@withApi
     chatModel.currentUser.value = user
     if (chatModel.users.isEmpty()) {
       chatModel.controller.startChat(user)
       chatModel.controller.appPrefs.onboardingStage.set(OnboardingStage.Step3_CreateSimpleXAddress)
     } else {
-      val users = chatModel.controller.listUsers()
+      val users = chatModel.controller.listUsers(rhId)
       chatModel.users.clear()
       chatModel.users.addAll(users)
-      chatModel.controller.getUserChatData()
+      chatModel.controller.getUserChatData(rhId)
       close()
     }
   }
@@ -190,7 +191,7 @@ fun createProfileInProfiles(chatModel: ChatModel, displayName: String, close: ()
 fun createProfileOnboarding(chatModel: ChatModel, displayName: String, close: () -> Unit) {
   withApi {
     chatModel.controller.apiCreateActiveUser(
-      Profile(displayName.trim(), "", null)
+      null, Profile(displayName.trim(), "", null)
     ) ?: return@withApi
     val onboardingStage = chatModel.controller.appPrefs.onboardingStage
     if (chatModel.users.isEmpty()) {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/CallManager.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/CallManager.kt
index f601776f9..d0c9a6e4c 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/CallManager.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/CallManager.kt
@@ -43,6 +43,7 @@ class CallManager(val chatModel: ChatModel) {
   private fun justAcceptIncomingCall(invitation: RcvCallInvitation) {
     with (chatModel) {
       activeCall.value = Call(
+        remoteHostId = invitation.remoteHostId,
         contact = invitation.contact,
         callState = CallState.InvitationAccepted,
         localMedia = invitation.callType.media,
@@ -76,7 +77,7 @@ class CallManager(val chatModel: ChatModel) {
         Log.d(TAG, "CallManager.endCall: ending call...")
         callCommand.add(WCallCommand.End)
         showCallView.value = false
-        controller.apiEndCall(call.contact)
+        controller.apiEndCall(call.remoteHostId, call.contact)
         activeCall.value = null
       }
     }
@@ -90,7 +91,7 @@ class CallManager(val chatModel: ChatModel) {
         ntfManager.cancelCallNotification()
       }
       withApi {
-        if (!controller.apiRejectCall(invitation.contact)) {
+        if (!controller.apiRejectCall(invitation.remoteHostId, invitation.contact)) {
           Log.e(TAG, "apiRejectCall error")
         }
       }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/WebRTC.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/WebRTC.kt
index 4be49d4c0..64904ba7a 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/WebRTC.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/WebRTC.kt
@@ -11,6 +11,7 @@ import java.util.*
 import kotlin.collections.ArrayList
 
 data class Call(
+  val remoteHostId: Long? = null,
   val contact: Contact,
   val callState: CallState,
   val localMedia: CallMediaType,
@@ -95,7 +96,14 @@ sealed class WCallResponse {
 @Serializable data class WebRTCSession(val rtcSession: String, val rtcIceCandidates: String)
 @Serializable data class WebRTCExtraInfo(val rtcIceCandidates: String)
 @Serializable data class CallType(val media: CallMediaType, val capabilities: CallCapabilities)
-@Serializable data class RcvCallInvitation(val user: User, val contact: Contact, val callType: CallType, val sharedKey: String? = null, val callTs: Instant) {
+@Serializable data class RcvCallInvitation(
+  val remoteHostId: Long? = null,
+  val user: User,
+  val contact: Contact,
+  val callType: CallType,
+  val sharedKey: String? = null,
+  val callTs: Instant
+) {
   val callTypeText: String get() = generalGetString(when(callType.media) {
     CallMediaType.Video -> if (sharedKey == null) MR.strings.video_call_no_encryption else MR.strings.encrypted_video_call
     CallMediaType.Audio -> if (sharedKey == null) MR.strings.audio_call_no_encryption else MR.strings.encrypted_audio_call
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt
index b7c5e66a6..5816c8952 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt
@@ -61,6 +61,7 @@ fun ChatInfoView(
     val contactNetworkStatus = remember(chatModel.networkStatuses.toMap(), contact) {
       mutableStateOf(chatModel.contactNetworkStatus(contact))
     }
+    val chatRh = chat.remoteHostId
     val sendReceipts = remember(contact.id) { mutableStateOf(SendReceipts.fromBool(contact.chatSettings.sendRcpts, currentUser.sendRcptsContacts)) }
     ChatInfoLayout(
       chat,
@@ -81,25 +82,25 @@ fun ChatInfoView(
       connectionCode,
       developerTools,
       onLocalAliasChanged = {
-        setContactAlias(chat.chatInfo.apiId, it, chatModel)
+        setContactAlias(chat, it, chatModel)
       },
       openPreferences = {
         ModalManager.end.showCustomModal { close ->
           val user = chatModel.currentUser.value
           if (user != null) {
-            ContactPreferencesView(chatModel, user, contact.contactId, close)
+            ContactPreferencesView(chatModel, user, chatRh, contact.contactId, close)
           }
         }
       },
-      deleteContact = { deleteContactDialog(chat.chatInfo, chatModel, close) },
-      clearChat = { clearChatDialog(chat.chatInfo, chatModel, close) },
+      deleteContact = { deleteContactDialog(chat, chatModel, close) },
+      clearChat = { clearChatDialog(chat, chatModel, close) },
       switchContactAddress = {
         showSwitchAddressAlert(switchAddress = {
           withApi {
-            val cStats = chatModel.controller.apiSwitchContact(contact.contactId)
+            val cStats = chatModel.controller.apiSwitchContact(chatRh, contact.contactId)
             connStats.value = cStats
             if (cStats != null) {
-              chatModel.updateContactConnectionStats(contact, cStats)
+              chatModel.updateContactConnectionStats(chatRh, contact, cStats)
             }
             close.invoke()
           }
@@ -108,20 +109,20 @@ fun ChatInfoView(
       abortSwitchContactAddress = {
         showAbortSwitchAddressAlert(abortSwitchAddress = {
           withApi {
-            val cStats = chatModel.controller.apiAbortSwitchContact(contact.contactId)
+            val cStats = chatModel.controller.apiAbortSwitchContact(chatRh, contact.contactId)
             connStats.value = cStats
             if (cStats != null) {
-              chatModel.updateContactConnectionStats(contact, cStats)
+              chatModel.updateContactConnectionStats(chatRh, contact, cStats)
             }
           }
         })
       },
       syncContactConnection = {
         withApi {
-          val cStats = chatModel.controller.apiSyncContactRatchet(contact.contactId, force = false)
+          val cStats = chatModel.controller.apiSyncContactRatchet(chatRh, contact.contactId, force = false)
           connStats.value = cStats
           if (cStats != null) {
-            chatModel.updateContactConnectionStats(contact, cStats)
+            chatModel.updateContactConnectionStats(chatRh, contact, cStats)
           }
           close.invoke()
         }
@@ -129,10 +130,10 @@ fun ChatInfoView(
       syncContactConnectionForce = {
         showSyncConnectionForceAlert(syncConnectionForce = {
           withApi {
-            val cStats = chatModel.controller.apiSyncContactRatchet(contact.contactId, force = true)
+            val cStats = chatModel.controller.apiSyncContactRatchet(chatRh, contact.contactId, force = true)
             connStats.value = cStats
             if (cStats != null) {
-              chatModel.updateContactConnectionStats(contact, cStats)
+              chatModel.updateContactConnectionStats(chatRh, contact, cStats)
             }
             close.invoke()
           }
@@ -146,9 +147,10 @@ fun ChatInfoView(
               connectionCode,
               ct.verified,
               verify = { code ->
-                chatModel.controller.apiVerifyContact(ct.contactId, code)?.let { r ->
+                chatModel.controller.apiVerifyContact(chatRh, ct.contactId, code)?.let { r ->
                   val (verified, existingCode) = r
                   chatModel.updateContact(
+                    chatRh,
                     ct.copy(
                       activeConn = ct.activeConn?.copy(
                         connectionCode = if (verified) SecurityCode(existingCode, Clock.System.now()) else null
@@ -195,7 +197,8 @@ sealed class SendReceipts {
   }
 }
 
-fun deleteContactDialog(chatInfo: ChatInfo, chatModel: ChatModel, close: (() -> Unit)? = null) {
+fun deleteContactDialog(chat: Chat, chatModel: ChatModel, close: (() -> Unit)? = null) {
+  val chatInfo = chat.chatInfo
   AlertManager.shared.showAlertDialogButtonsColumn(
     title = generalGetString(MR.strings.delete_contact_question),
     text = AnnotatedString(generalGetString(MR.strings.delete_contact_all_messages_deleted_cannot_undo_warning)),
@@ -206,7 +209,7 @@ fun deleteContactDialog(chatInfo: ChatInfo, chatModel: ChatModel, close: (() ->
           SectionItemView({
             AlertManager.shared.hideAlert()
             withApi {
-              deleteContact(chatInfo, chatModel, close, notify = true)
+              deleteContact(chat, chatModel, close, notify = true)
             }
           }) {
             Text(generalGetString(MR.strings.delete_and_notify_contact), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = MaterialTheme.colors.error)
@@ -215,7 +218,7 @@ fun deleteContactDialog(chatInfo: ChatInfo, chatModel: ChatModel, close: (() ->
           SectionItemView({
             AlertManager.shared.hideAlert()
             withApi {
-              deleteContact(chatInfo, chatModel, close, notify = false)
+              deleteContact(chat, chatModel, close, notify = false)
             }
           }) {
             Text(generalGetString(MR.strings.delete_verb), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = MaterialTheme.colors.error)
@@ -225,7 +228,7 @@ fun deleteContactDialog(chatInfo: ChatInfo, chatModel: ChatModel, close: (() ->
           SectionItemView({
             AlertManager.shared.hideAlert()
             withApi {
-              deleteContact(chatInfo, chatModel, close)
+              deleteContact(chat, chatModel, close)
             }
           }) {
             Text(generalGetString(MR.strings.delete_verb), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = MaterialTheme.colors.error)
@@ -242,11 +245,13 @@ fun deleteContactDialog(chatInfo: ChatInfo, chatModel: ChatModel, close: (() ->
   )
 }
 
-fun deleteContact(chatInfo: ChatInfo, chatModel: ChatModel, close: (() -> Unit)?, notify: Boolean? = null) {
+fun deleteContact(chat: Chat, chatModel: ChatModel, close: (() -> Unit)?, notify: Boolean? = null) {
+  val chatInfo = chat.chatInfo
   withApi {
-    val r = chatModel.controller.apiDeleteChat(chatInfo.chatType, chatInfo.apiId, notify)
+    val chatRh = chat.remoteHostId
+    val r = chatModel.controller.apiDeleteChat(chatRh, chatInfo.chatType, chatInfo.apiId, notify)
     if (r) {
-      chatModel.removeChat(chatInfo.id)
+      chatModel.removeChat(chatRh, chatInfo.id)
       if (chatModel.chatId.value == chatInfo.id) {
         chatModel.chatId.value = null
         ModalManager.end.closeModals()
@@ -257,16 +262,18 @@ fun deleteContact(chatInfo: ChatInfo, chatModel: ChatModel, close: (() -> Unit)?
   }
 }
 
-fun clearChatDialog(chatInfo: ChatInfo, chatModel: ChatModel, close: (() -> Unit)? = null) {
+fun clearChatDialog(chat: Chat, chatModel: ChatModel, close: (() -> Unit)? = null) {
+  val chatInfo = chat.chatInfo
   AlertManager.shared.showAlertDialog(
     title = generalGetString(MR.strings.clear_chat_question),
     text = generalGetString(MR.strings.clear_chat_warning),
     confirmText = generalGetString(MR.strings.clear_verb),
     onConfirm = {
       withApi {
-        val updatedChatInfo = chatModel.controller.apiClearChat(chatInfo.chatType, chatInfo.apiId)
+        val chatRh = chat.remoteHostId
+        val updatedChatInfo = chatModel.controller.apiClearChat(chatRh, chatInfo.chatType, chatInfo.apiId)
         if (updatedChatInfo != null) {
-          chatModel.clearChat(updatedChatInfo)
+          chatModel.clearChat(chatRh, updatedChatInfo)
           ntfManager.cancelNotificationsForChat(chatInfo.id)
           close?.invoke()
         }
@@ -669,9 +676,10 @@ fun ShareAddressButton(onClick: () -> Unit) {
   )
 }
 
-private fun setContactAlias(contactApiId: Long, localAlias: String, chatModel: ChatModel) = withApi {
-  chatModel.controller.apiSetContactAlias(contactApiId, localAlias)?.let {
-    chatModel.updateContact(it)
+private fun setContactAlias(chat: Chat, localAlias: String, chatModel: ChatModel) = withApi {
+  val chatRh = chat.remoteHostId
+  chatModel.controller.apiSetContactAlias(chatRh, chat.chatInfo.apiId, localAlias)?.let {
+    chatModel.updateContact(chatRh, it)
   }
 }
 
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt
index 7097c77d1..862212217 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt
@@ -46,7 +46,6 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
   val activeChat = remember { mutableStateOf(chatModel.chats.firstOrNull { chat -> chat.chatInfo.id == chatId }) }
   val searchText = rememberSaveable { mutableStateOf("") }
   val user = chatModel.currentUser.value
-  val rhId = remember { chatModel.currentRemoteHost }.value?.remoteHostId
   val useLinkPreviews = chatModel.controller.appPrefs.privacyLinkPreviews.get()
   val composeState = rememberSaveable(saver = ComposeState.saver()) {
     mutableStateOf(
@@ -101,11 +100,12 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
     }
   }
   val view = LocalMultiplatformView()
-  if (activeChat.value == null || user == null) {
+  val chat = activeChat.value
+  if (chat == null || user == null) {
     chatModel.chatId.value = null
     ModalManager.end.closeModals()
   } else {
-    val chat = activeChat.value!!
+    val chatRh = chat.remoteHostId
     // We need to have real unreadCount value for displaying it inside top right button
     // Having activeChat reloaded on every change in it is inefficient (UI lags)
     val unreadCount = remember {
@@ -167,11 +167,11 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
           var preloadedCode: String? = null
           var preloadedLink: Pair<String, GroupMemberRole>? = null
           if (chat.chatInfo is ChatInfo.Direct) {
-            preloadedContactInfo = chatModel.controller.apiContactInfo(chat.chatInfo.apiId)
-            preloadedCode = chatModel.controller.apiGetContactCode(chat.chatInfo.apiId)?.second
+            preloadedContactInfo = chatModel.controller.apiContactInfo(chatRh, chat.chatInfo.apiId)
+            preloadedCode = chatModel.controller.apiGetContactCode(chatRh, chat.chatInfo.apiId)?.second
           } else if (chat.chatInfo is ChatInfo.Group) {
-            setGroupMembers(chat.chatInfo.groupInfo, chatModel)
-            preloadedLink = chatModel.controller.apiGetGroupLink(chat.chatInfo.groupInfo.groupId)
+            setGroupMembers(chatRh, chat.chatInfo.groupInfo, chatModel)
+            preloadedLink = chatModel.controller.apiGetGroupLink(chatRh, chat.chatInfo.groupInfo.groupId)
           }
           ModalManager.end.showModalCloseable(true) { close ->
             val chat = remember { activeChat }.value
@@ -179,20 +179,20 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
               var contactInfo: Pair<ConnectionStats?, Profile?>? by remember { mutableStateOf(preloadedContactInfo) }
               var code: String? by remember { mutableStateOf(preloadedCode) }
               KeyChangeEffect(chat.id, ChatModel.networkStatuses.toMap()) {
-                contactInfo = chatModel.controller.apiContactInfo(chat.chatInfo.apiId)
+                contactInfo = chatModel.controller.apiContactInfo(chatRh, chat.chatInfo.apiId)
                 preloadedContactInfo = contactInfo
-                code = chatModel.controller.apiGetContactCode(chat.chatInfo.apiId)?.second
+                code = chatModel.controller.apiGetContactCode(chatRh, chat.chatInfo.apiId)?.second
                 preloadedCode = code
               }
               ChatInfoView(chatModel, (chat.chatInfo as ChatInfo.Direct).contact, contactInfo?.first, contactInfo?.second, chat.chatInfo.localAlias, code, close)
             } else if (chat?.chatInfo is ChatInfo.Group) {
               var link: Pair<String, GroupMemberRole>? by remember(chat.id) { mutableStateOf(preloadedLink) }
               KeyChangeEffect(chat.id) {
-                setGroupMembers((chat.chatInfo as ChatInfo.Group).groupInfo, chatModel)
-                link = chatModel.controller.apiGetGroupLink(chat.chatInfo.groupInfo.groupId)
+                setGroupMembers(chatRh, (chat.chatInfo as ChatInfo.Group).groupInfo, chatModel)
+                link = chatModel.controller.apiGetGroupLink(chatRh, chat.chatInfo.groupInfo.groupId)
                 preloadedLink = link
               }
-              GroupChatInfoView(chatModel, link?.first, link?.second, {
+              GroupChatInfoView(chatModel, chatRh, chat.id, link?.first, link?.second, {
                 link = it
                 preloadedLink = it
               }, close)
@@ -203,19 +203,19 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
       showMemberInfo = { groupInfo: GroupInfo, member: GroupMember ->
         hideKeyboard(view)
         withApi {
-          val r = chatModel.controller.apiGroupMemberInfo(groupInfo.groupId, member.groupMemberId)
+          val r = chatModel.controller.apiGroupMemberInfo(chatRh, groupInfo.groupId, member.groupMemberId)
           val stats = r?.second
           val (_, code) = if (member.memberActive) {
-            val memCode = chatModel.controller.apiGetGroupMemberCode(groupInfo.apiId, member.groupMemberId)
+            val memCode = chatModel.controller.apiGetGroupMemberCode(chatRh, groupInfo.apiId, member.groupMemberId)
             member to memCode?.second
           } else {
             member to null
           }
-          setGroupMembers(groupInfo, chatModel)
+          setGroupMembers(chatRh, groupInfo, chatModel)
           ModalManager.end.closeModals()
           ModalManager.end.showModalCloseable(true) { close ->
             remember { derivedStateOf { chatModel.getGroupMember(member.groupMemberId) } }.value?.let { mem ->
-              GroupMemberInfoView(groupInfo, mem, stats, code, chatModel, close, close)
+              GroupMemberInfoView(chatRh, groupInfo, mem, stats, code, chatModel, close, close)
             }
           }
         }
@@ -226,7 +226,7 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
         if (c != null && firstId != null) {
           withApi {
             Log.d(TAG, "TODOCHAT: loadPrevMessages: loading for ${c.id}, current chatId ${ChatModel.chatId.value}, size was ${ChatModel.chatItems.size}")
-            apiLoadPrevMessages(c.chatInfo, chatModel, firstId, searchText.value)
+            apiLoadPrevMessages(c, chatModel, firstId, searchText.value)
             Log.d(TAG, "TODOCHAT: loadPrevMessages: loaded for ${c.id}, current chatId ${ChatModel.chatId.value}, size now ${ChatModel.chatItems.size}")
           }
         }
@@ -242,6 +242,7 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
           val toChatItem: ChatItem?
           if (mode == CIDeleteMode.cidmBroadcast && groupInfo != null && groupMember != null) {
             val r = chatModel.controller.apiDeleteMemberChatItem(
+              chatRh,
               groupId = groupInfo.groupId,
               groupMemberId = groupMember.groupMemberId,
               itemId = itemId
@@ -250,6 +251,7 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
             toChatItem = r?.second
           } else {
             val r = chatModel.controller.apiDeleteChatItem(
+              chatRh,
               type = cInfo.chatType,
               id = cInfo.apiId,
               itemId = itemId,
@@ -259,9 +261,9 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
             toChatItem = r?.toChatItem?.chatItem
           }
           if (toChatItem == null && deletedChatItem != null) {
-            chatModel.removeChatItem(cInfo, deletedChatItem)
+            chatModel.removeChatItem(chatRh, cInfo, deletedChatItem)
           } else if (toChatItem != null) {
-            chatModel.upsertChatItem(cInfo, toChatItem)
+            chatModel.upsertChatItem(chatRh, cInfo, toChatItem)
           }
         }
       },
@@ -272,27 +274,27 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
             val deletedItems: ArrayList<ChatItem> = arrayListOf()
             for (itemId in itemIds) {
               val di = chatModel.controller.apiDeleteChatItem(
-                chatInfo.chatType, chatInfo.apiId, itemId, CIDeleteMode.cidmInternal
+                chatRh, chatInfo.chatType, chatInfo.apiId, itemId, CIDeleteMode.cidmInternal
               )?.deletedChatItem?.chatItem
               if (di != null) {
                 deletedItems.add(di)
               }
             }
             for (di in deletedItems) {
-              chatModel.removeChatItem(chatInfo, di)
+              chatModel.removeChatItem(chatRh, chatInfo, di)
             }
           }
         }
       },
       receiveFile = { fileId, encrypted ->
-        withApi { chatModel.controller.receiveFile(rhId, user, fileId, encrypted) }
+        withApi { chatModel.controller.receiveFile(chatRh, user, fileId, encrypted) }
       },
       cancelFile = { fileId ->
-        withApi { chatModel.controller.cancelFile(rhId, user, fileId) }
+        withApi { chatModel.controller.cancelFile(chatRh, user, fileId) }
       },
       joinGroup = { groupId, onComplete ->
         withApi {
-          chatModel.controller.apiJoinGroup(groupId)
+          chatModel.controller.apiJoinGroup(chatRh, groupId)
           onComplete.invoke()
         }
       },
@@ -300,7 +302,7 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
         withBGApi {
           val cInfo = chat.chatInfo
           if (cInfo is ChatInfo.Direct) {
-            chatModel.activeCall.value = Call(contact = cInfo.contact, callState = CallState.WaitCapabilities, localMedia = media)
+            chatModel.activeCall.value = Call(remoteHostId = chatRh, contact = cInfo.contact, callState = CallState.WaitCapabilities, localMedia = media)
             chatModel.showCallView.value = true
             chatModel.callCommand.add(WCallCommand.Capabilities(media))
           }
@@ -321,48 +323,48 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
       },
       acceptFeature = { contact, feature, param ->
         withApi {
-          chatModel.controller.allowFeatureToContact(contact, feature, param)
+          chatModel.controller.allowFeatureToContact(chatRh, contact, feature, param)
         }
       },
       openDirectChat = { contactId ->
         withApi {
-          openDirectChat(contactId, chatModel)
+          openDirectChat(chatRh, contactId, chatModel)
         }
       },
       updateContactStats = { contact ->
         withApi {
-          val r = chatModel.controller.apiContactInfo(chat.chatInfo.apiId)
+          val r = chatModel.controller.apiContactInfo(chatRh, chat.chatInfo.apiId)
           if (r != null) {
             val contactStats = r.first
             if (contactStats != null)
-            chatModel.updateContactConnectionStats(contact, contactStats)
+            chatModel.updateContactConnectionStats(chatRh, contact, contactStats)
           }
         }
       },
       updateMemberStats = { groupInfo, member ->
         withApi {
-          val r = chatModel.controller.apiGroupMemberInfo(groupInfo.groupId, member.groupMemberId)
+          val r = chatModel.controller.apiGroupMemberInfo(chatRh, groupInfo.groupId, member.groupMemberId)
           if (r != null) {
             val memStats = r.second
             if (memStats != null) {
-              chatModel.updateGroupMemberConnectionStats(groupInfo, r.first, memStats)
+              chatModel.updateGroupMemberConnectionStats(chatRh, groupInfo, r.first, memStats)
             }
           }
         }
       },
       syncContactConnection = { contact ->
         withApi {
-          val cStats = chatModel.controller.apiSyncContactRatchet(contact.contactId, force = false)
+          val cStats = chatModel.controller.apiSyncContactRatchet(chatRh, contact.contactId, force = false)
           if (cStats != null) {
-            chatModel.updateContactConnectionStats(contact, cStats)
+            chatModel.updateContactConnectionStats(chatRh, contact, cStats)
           }
         }
       },
       syncMemberConnection = { groupInfo, member ->
         withApi {
-          val r = chatModel.controller.apiSyncGroupMemberRatchet(groupInfo.apiId, member.groupMemberId, force = false)
+          val r = chatModel.controller.apiSyncGroupMemberRatchet(chatRh, groupInfo.apiId, member.groupMemberId, force = false)
           if (r != null) {
-            chatModel.updateGroupMemberConnectionStats(groupInfo, r.first, r.second)
+            chatModel.updateGroupMemberConnectionStats(chatRh, groupInfo, r.first, r.second)
           }
         }
       },
@@ -375,6 +377,7 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
       setReaction = { cInfo, cItem, add, reaction ->
         withApi {
           val updatedCI = chatModel.controller.apiChatItemReaction(
+            rh = chatRh,
             type = cInfo.chatType,
             id = cInfo.apiId,
             itemId = cItem.id,
@@ -388,10 +391,10 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
       },
       showItemDetails = { cInfo, cItem ->
         withApi {
-          val ciInfo = chatModel.controller.apiGetChatItemInfo(cInfo.chatType, cInfo.apiId, cItem.id)
+          val ciInfo = chatModel.controller.apiGetChatItemInfo(chatRh, cInfo.chatType, cInfo.apiId, cItem.id)
           if (ciInfo != null) {
             if (chat.chatInfo is ChatInfo.Group) {
-              setGroupMembers(chat.chatInfo.groupInfo, chatModel)
+              setGroupMembers(chatRh, chat.chatInfo.groupInfo, chatModel)
             }
             ModalManager.end.closeModals()
             ModalManager.end.showModal(endButtons = { ShareButton {
@@ -405,28 +408,29 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
       addMembers = { groupInfo ->
         hideKeyboard(view)
         withApi {
-          setGroupMembers(groupInfo, chatModel)
+          setGroupMembers(chatRh, groupInfo, chatModel)
           ModalManager.end.closeModals()
           ModalManager.end.showModalCloseable(true) { close ->
-            AddGroupMembersView(groupInfo, false, chatModel, close)
+            AddGroupMembersView(chatRh, groupInfo, false, chatModel, close)
           }
         }
       },
       openGroupLink = { groupInfo ->
         hideKeyboard(view)
         withApi {
-          val link = chatModel.controller.apiGetGroupLink(groupInfo.groupId)
+          val link = chatModel.controller.apiGetGroupLink(chatRh, groupInfo.groupId)
           ModalManager.end.closeModals()
           ModalManager.end.showModalCloseable(true) {
-            GroupLinkView(chatModel, groupInfo, link?.first, link?.second, onGroupLinkUpdated = null)
+            GroupLinkView(chatModel, chatRh, groupInfo, link?.first, link?.second, onGroupLinkUpdated = null)
           }
         }
       },
       markRead = { range, unreadCountAfter ->
-        chatModel.markChatItemsRead(chat.chatInfo, range, unreadCountAfter)
+        chatModel.markChatItemsRead(chat, range, unreadCountAfter)
         ntfManager.cancelNotificationsForChat(chat.id)
         withBGApi {
           chatModel.controller.apiChatRead(
+            chatRh,
             chat.chatInfo.chatType,
             chat.chatInfo.apiId,
             range
@@ -438,7 +442,7 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId:
         if (searchText.value == value) return@ChatLayout
         val c = chatModel.getChat(chat.chatInfo.id) ?: return@ChatLayout
         withApi {
-          apiFindMessages(c.chatInfo, chatModel, value)
+          apiFindMessages(c, chatModel, value)
           searchText.value = value
         }
       },
@@ -1254,14 +1258,16 @@ private fun markUnreadChatAsRead(activeChat: MutableState<Chat?>, chatModel: Cha
   val chat = activeChat.value
   if (chat?.chatStats?.unreadChat != true) return
   withApi {
+    val chatRh = chat.remoteHostId
     val success = chatModel.controller.apiChatUnread(
+      chatRh,
       chat.chatInfo.chatType,
       chat.chatInfo.apiId,
       false
     )
     if (success && chat.id == activeChat.value?.id) {
       activeChat.value = chat.copy(chatStats = chat.chatStats.copy(unreadChat = false))
-      chatModel.replaceChat(chat.id, activeChat.value!!)
+      chatModel.replaceChat(chatRh, chat.id, activeChat.value!!)
     }
   }
 }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ComposeView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ComposeView.kt
index a9b7014d5..b8076b147 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ComposeView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ComposeView.kt
@@ -351,9 +351,10 @@ fun ComposeView(
     }
   }
 
-  suspend fun send(rhId: Long?, cInfo: ChatInfo, mc: MsgContent, quoted: Long?, file: CryptoFile? = null, live: Boolean = false, ttl: Int?): ChatItem? {
+  suspend fun send(chat: Chat, mc: MsgContent, quoted: Long?, file: CryptoFile? = null, live: Boolean = false, ttl: Int?): ChatItem? {
+    val cInfo = chat.chatInfo
     val aChatItem = chatModel.controller.apiSendMessage(
-      rhId = rhId,
+      rh = chat.remoteHostId,
       type = cInfo.chatType,
       id = cInfo.apiId,
       file = file,
@@ -363,7 +364,7 @@ fun ComposeView(
       ttl = ttl
     )
     if (aChatItem != null) {
-      chatModel.addChatItem(cInfo, aChatItem.chatItem)
+      chatModel.addChatItem(chat.remoteHostId, cInfo, aChatItem.chatItem)
       return aChatItem.chatItem
     }
     if (file != null) removeFile(file.filePath)
@@ -410,23 +411,25 @@ fun ComposeView(
 
     suspend fun sendMemberContactInvitation() {
       val mc = checkLinkPreview()
-      val contact = chatModel.controller.apiSendMemberContactInvitation(chat.chatInfo.apiId, mc)
+      val contact = chatModel.controller.apiSendMemberContactInvitation(chat.remoteHostId, chat.chatInfo.apiId, mc)
       if (contact != null) {
-        chatModel.updateContact(contact)
+        chatModel.updateContact(chat.remoteHostId, contact)
       }
     }
 
-    suspend fun updateMessage(ei: ChatItem, cInfo: ChatInfo, live: Boolean): ChatItem? {
+    suspend fun updateMessage(ei: ChatItem, chat: Chat, live: Boolean): ChatItem? {
+      val cInfo = chat.chatInfo
       val oldMsgContent = ei.content.msgContent
       if (oldMsgContent != null) {
         val updatedItem = chatModel.controller.apiUpdateChatItem(
+          rh = chat.remoteHostId,
           type = cInfo.chatType,
           id = cInfo.apiId,
           itemId = ei.meta.itemId,
           mc = updateMsgContent(oldMsgContent),
           live = live
         )
-        if (updatedItem != null) chatModel.upsertChatItem(cInfo, updatedItem.chatItem)
+        if (updatedItem != null) chatModel.upsertChatItem(chat.remoteHostId, cInfo, updatedItem.chatItem)
         return updatedItem?.chatItem
       }
       return null
@@ -444,9 +447,9 @@ fun ComposeView(
       sent = null
     } else if (cs.contextItem is ComposeContextItem.EditingItem) {
       val ei = cs.contextItem.chatItem
-      sent = updateMessage(ei, cInfo, live)
+      sent = updateMessage(ei, chat, live)
     } else if (liveMessage != null && liveMessage.sent) {
-      sent = updateMessage(liveMessage.chatItem, cInfo, live)
+      sent = updateMessage(liveMessage.chatItem, chat, live)
     } else {
       val msgs: ArrayList<MsgContent> = ArrayList()
       val files: ArrayList<CryptoFile> = ArrayList()
@@ -528,7 +531,7 @@ fun ComposeView(
             localPath = file.filePath
           )
         }
-        sent = send(remoteHost?.remoteHostId, cInfo, content, if (index == 0) quotedItemId else null, file,
+        sent = send(chat, content, if (index == 0) quotedItemId else null, file,
           live = if (content !is MsgContent.MCVoice && index == msgs.lastIndex) live else false,
           ttl = ttl
         )
@@ -538,7 +541,7 @@ fun ComposeView(
             cs.preview is ComposePreview.FilePreview ||
             cs.preview is ComposePreview.VoicePreview)
       ) {
-        sent = send(remoteHost?.remoteHostId, cInfo, MsgContent.MCText(msgText), quotedItemId, null, live, ttl)
+        sent = send(chat, MsgContent.MCText(msgText), quotedItemId, null, live, ttl)
       }
     }
     clearState(live)
@@ -573,7 +576,7 @@ fun ComposeView(
   fun allowVoiceToContact() {
     val contact = (chat.chatInfo as ChatInfo.Direct?)?.contact ?: return
     withApi {
-      chatModel.controller.allowFeatureToContact(contact, ChatFeature.Voice)
+      chatModel.controller.allowFeatureToContact(chat.remoteHostId, contact, ChatFeature.Voice)
     }
   }
 
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ContactPreferences.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ContactPreferences.kt
index 465603d40..c12982ada 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ContactPreferences.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ContactPreferences.kt
@@ -25,6 +25,7 @@ import chat.simplex.res.MR
 fun ContactPreferencesView(
   m: ChatModel,
   user: User,
+  rhId: Long?,
   contactId: Long,
   close: () -> Unit,
 ) {
@@ -36,9 +37,9 @@ fun ContactPreferencesView(
   fun savePrefs(afterSave: () -> Unit = {}) {
     withApi {
       val prefs = contactFeaturesAllowedToPrefs(featuresAllowed)
-      val toContact = m.controller.apiSetContactPrefs(ct.contactId, prefs)
+      val toContact = m.controller.apiSetContactPrefs(rhId, ct.contactId, prefs)
       if (toContact != null) {
-        m.updateContact(toContact)
+        m.updateContact(rhId, toContact)
         currentFeaturesAllowed = featuresAllowed
       }
       afterSave()
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/AddGroupMembersView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/AddGroupMembersView.kt
index 90ab1b45f..ff23d40b8 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/AddGroupMembersView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/AddGroupMembersView.kt
@@ -33,7 +33,7 @@ import chat.simplex.common.platform.*
 import chat.simplex.res.MR
 
 @Composable
-fun AddGroupMembersView(groupInfo: GroupInfo, creatingGroup: Boolean = false, chatModel: ChatModel, close: () -> Unit) {
+fun AddGroupMembersView(rhId: Long?, groupInfo: GroupInfo, creatingGroup: Boolean = false, chatModel: ChatModel, close: () -> Unit) {
   val selectedContacts = remember { mutableStateListOf<Long>() }
   val selectedRole = remember { mutableStateOf(GroupMemberRole.Member) }
   var allowModifyMembers by remember { mutableStateOf(true) }
@@ -49,16 +49,16 @@ fun AddGroupMembersView(groupInfo: GroupInfo, creatingGroup: Boolean = false, ch
     searchText,
     openPreferences = {
       ModalManager.end.showCustomModal { close ->
-        GroupPreferencesView(chatModel, groupInfo.id, close)
+        GroupPreferencesView(chatModel, rhId, groupInfo.id, close)
       }
     },
     inviteMembers = {
       allowModifyMembers = false
       withApi {
         for (contactId in selectedContacts) {
-          val member = chatModel.controller.apiAddMember(groupInfo.groupId, contactId, selectedRole.value)
+          val member = chatModel.controller.apiAddMember(rhId, groupInfo.groupId, contactId, selectedRole.value)
           if (member != null) {
-            chatModel.upsertGroupMember(groupInfo, member)
+            chatModel.upsertGroupMember(rhId, groupInfo, member)
           } else {
             break
           }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupChatInfoView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupChatInfoView.kt
index 8c9619703..49d76d8ec 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupChatInfoView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupChatInfoView.kt
@@ -41,9 +41,10 @@ import kotlinx.coroutines.launch
 const val SMALL_GROUPS_RCPS_MEM_LIMIT: Int = 20
 
 @Composable
-fun GroupChatInfoView(chatModel: ChatModel, groupLink: String?, groupLinkMemberRole: GroupMemberRole?, onGroupLinkUpdated: (Pair<String, GroupMemberRole>?) -> Unit, close: () -> Unit) {
+fun GroupChatInfoView(chatModel: ChatModel, rhId: Long?, chatId: String, groupLink: String?, groupLinkMemberRole: GroupMemberRole?, onGroupLinkUpdated: (Pair<String, GroupMemberRole>?) -> Unit, close: () -> Unit) {
   BackHandler(onBack = close)
-  val chat = chatModel.chats.firstOrNull { it.id == chatModel.chatId.value }
+  // TODO derivedStateOf?
+  val chat = chatModel.chats.firstOrNull { ch -> ch.id == chatId && ch.remoteHostId == rhId }
   val currentUser = chatModel.currentUser.value
   val developerTools = chatModel.controller.appPrefs.developerTools.get()
   if (chat != null && chat.chatInfo is ChatInfo.Group && currentUser != null) {
@@ -68,25 +69,25 @@ fun GroupChatInfoView(chatModel: ChatModel, groupLink: String?, groupLinkMemberR
       groupLink,
       addMembers = {
         withApi {
-          setGroupMembers(groupInfo, chatModel)
+          setGroupMembers(rhId, groupInfo, chatModel)
           ModalManager.end.showModalCloseable(true) { close ->
-            AddGroupMembersView(groupInfo, false, chatModel, close)
+            AddGroupMembersView(rhId, groupInfo, false, chatModel, close)
           }
         }
       },
       showMemberInfo = { member ->
         withApi {
-          val r = chatModel.controller.apiGroupMemberInfo(groupInfo.groupId, member.groupMemberId)
+          val r = chatModel.controller.apiGroupMemberInfo(rhId, groupInfo.groupId, member.groupMemberId)
           val stats = r?.second
           val (_, code) = if (member.memberActive) {
-            val memCode = chatModel.controller.apiGetGroupMemberCode(groupInfo.apiId, member.groupMemberId)
+            val memCode = chatModel.controller.apiGetGroupMemberCode(rhId, groupInfo.apiId, member.groupMemberId)
             member to memCode?.second
           } else {
             member to null
           }
           ModalManager.end.showModalCloseable(true) { closeCurrent ->
             remember { derivedStateOf { chatModel.getGroupMember(member.groupMemberId) } }.value?.let { mem ->
-              GroupMemberInfoView(groupInfo, mem, stats, code, chatModel, closeCurrent) {
+              GroupMemberInfoView(rhId, groupInfo, mem, stats, code, chatModel, closeCurrent) {
                 closeCurrent()
                 close()
               }
@@ -95,31 +96,33 @@ fun GroupChatInfoView(chatModel: ChatModel, groupLink: String?, groupLinkMemberR
         }
       },
       editGroupProfile = {
-        ModalManager.end.showCustomModal { close -> GroupProfileView(groupInfo, chatModel, close) }
+        ModalManager.end.showCustomModal { close -> GroupProfileView(rhId, groupInfo, chatModel, close) }
       },
       addOrEditWelcomeMessage = {
-        ModalManager.end.showCustomModal { close -> GroupWelcomeView(chatModel, groupInfo, close) }
+        ModalManager.end.showCustomModal { close -> GroupWelcomeView(chatModel, rhId, groupInfo, close) }
       },
       openPreferences = {
         ModalManager.end.showCustomModal { close ->
           GroupPreferencesView(
             chatModel,
+            rhId,
             chat.id,
             close
           )
         }
       },
-      deleteGroup = { deleteGroupDialog(chat.chatInfo, groupInfo, chatModel, close) },
-      clearChat = { clearChatDialog(chat.chatInfo, chatModel, close) },
-      leaveGroup = { leaveGroupDialog(groupInfo, chatModel, close) },
+      deleteGroup = { deleteGroupDialog(chat, groupInfo, chatModel, close) },
+      clearChat = { clearChatDialog(chat, chatModel, close) },
+      leaveGroup = { leaveGroupDialog(rhId, groupInfo, chatModel, close) },
       manageGroupLink = {
-          ModalManager.end.showModal { GroupLinkView(chatModel, groupInfo, groupLink, groupLinkMemberRole, onGroupLinkUpdated) }
+          ModalManager.end.showModal { GroupLinkView(chatModel, rhId, groupInfo, groupLink, groupLinkMemberRole, onGroupLinkUpdated) }
       }
     )
   }
 }
 
-fun deleteGroupDialog(chatInfo: ChatInfo, groupInfo: GroupInfo, chatModel: ChatModel, close: (() -> Unit)? = null) {
+fun deleteGroupDialog(chat: Chat, groupInfo: GroupInfo, chatModel: ChatModel, close: (() -> Unit)? = null) {
+  val chatInfo = chat.chatInfo
   val alertTextKey =
     if (groupInfo.membership.memberCurrent) MR.strings.delete_group_for_all_members_cannot_undo_warning
     else MR.strings.delete_group_for_self_cannot_undo_warning
@@ -129,9 +132,9 @@ fun deleteGroupDialog(chatInfo: ChatInfo, groupInfo: GroupInfo, chatModel: ChatM
     confirmText = generalGetString(MR.strings.delete_verb),
     onConfirm = {
       withApi {
-        val r = chatModel.controller.apiDeleteChat(chatInfo.chatType, chatInfo.apiId)
+        val r = chatModel.controller.apiDeleteChat(chat.remoteHostId, chatInfo.chatType, chatInfo.apiId)
         if (r) {
-          chatModel.removeChat(chatInfo.id)
+          chatModel.removeChat(chat.remoteHostId, chatInfo.id)
           if (chatModel.chatId.value == chatInfo.id) {
             chatModel.chatId.value = null
             ModalManager.end.closeModals()
@@ -145,14 +148,14 @@ fun deleteGroupDialog(chatInfo: ChatInfo, groupInfo: GroupInfo, chatModel: ChatM
   )
 }
 
-fun leaveGroupDialog(groupInfo: GroupInfo, chatModel: ChatModel, close: (() -> Unit)? = null) {
+fun leaveGroupDialog(rhId: Long?, groupInfo: GroupInfo, chatModel: ChatModel, close: (() -> Unit)? = null) {
   AlertManager.shared.showAlertDialog(
     title = generalGetString(MR.strings.leave_group_question),
     text = generalGetString(MR.strings.you_will_stop_receiving_messages_from_this_group_chat_history_will_be_preserved),
     confirmText = generalGetString(MR.strings.leave_group_button),
     onConfirm = {
       withApi {
-        chatModel.controller.leaveGroup(groupInfo.groupId)
+        chatModel.controller.leaveGroup(rhId, groupInfo.groupId)
         close?.invoke()
       }
     },
@@ -160,16 +163,16 @@ fun leaveGroupDialog(groupInfo: GroupInfo, chatModel: ChatModel, close: (() -> U
   )
 }
 
-private fun removeMemberAlert(groupInfo: GroupInfo, mem: GroupMember) {
+private fun removeMemberAlert(rhId: Long?, groupInfo: GroupInfo, mem: GroupMember) {
   AlertManager.shared.showAlertDialog(
     title = generalGetString(MR.strings.button_remove_member_question),
     text = generalGetString(MR.strings.member_will_be_removed_from_group_cannot_be_undone),
     confirmText = generalGetString(MR.strings.remove_member_confirmation),
     onConfirm = {
       withApi {
-        val updatedMember = chatModel.controller.apiRemoveMember(groupInfo.groupId, mem.groupMemberId)
+        val updatedMember = chatModel.controller.apiRemoveMember(rhId, groupInfo.groupId, mem.groupMemberId)
         if (updatedMember != null) {
-          chatModel.upsertGroupMember(groupInfo, updatedMember)
+          chatModel.upsertGroupMember(rhId, groupInfo, updatedMember)
         }
       }
     },
@@ -260,7 +263,7 @@ fun GroupChatInfoLayout(
       Divider()
       val showMenu = remember { mutableStateOf(false) }
       SectionItemViewLongClickable({ showMemberInfo(member) }, { showMenu.value = true }, minHeight = 54.dp) {
-        DropDownMenuForMember(member, groupInfo, showMenu)
+        DropDownMenuForMember(chat.remoteHostId, member, groupInfo, showMenu)
         MemberRow(member, onClick = { showMemberInfo(member) })
       }
     }
@@ -413,22 +416,22 @@ private fun MemberVerifiedShield() {
 }
 
 @Composable
-private fun DropDownMenuForMember(member: GroupMember, groupInfo: GroupInfo, showMenu: MutableState<Boolean>) {
+private fun DropDownMenuForMember(rhId: Long?, member: GroupMember, groupInfo: GroupInfo, showMenu: MutableState<Boolean>) {
   DefaultDropdownMenu(showMenu) {
     if (member.canBeRemoved(groupInfo)) {
       ItemAction(stringResource(MR.strings.remove_member_button), painterResource(MR.images.ic_delete), color = MaterialTheme.colors.error, onClick = {
-        removeMemberAlert(groupInfo, member)
+        removeMemberAlert(rhId, groupInfo, member)
         showMenu.value = false
       })
     }
     if (member.memberSettings.showMessages) {
       ItemAction(stringResource(MR.strings.block_member_button), painterResource(MR.images.ic_back_hand), color = MaterialTheme.colors.error, onClick = {
-        blockMemberAlert(groupInfo, member)
+        blockMemberAlert(rhId, groupInfo, member)
         showMenu.value = false
       })
     } else {
       ItemAction(stringResource(MR.strings.unblock_member_button), painterResource(MR.images.ic_do_not_touch), onClick = {
-        unblockMemberAlert(groupInfo, member)
+        unblockMemberAlert(rhId, groupInfo, member)
         showMenu.value = false
       })
     }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupLinkView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupLinkView.kt
index 809c7c2fd..02ce90243 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupLinkView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupLinkView.kt
@@ -25,6 +25,7 @@ import chat.simplex.res.MR
 @Composable
 fun GroupLinkView(
   chatModel: ChatModel,
+  rhId: Long?,
   groupInfo: GroupInfo,
   connReqContact: String?,
   memberRole: GroupMemberRole?,
@@ -38,7 +39,7 @@ fun GroupLinkView(
   fun createLink() {
     creatingLink = true
     withApi {
-      val link = chatModel.controller.apiCreateGroupLink(groupInfo.groupId)
+      val link = chatModel.controller.apiCreateGroupLink(rhId, groupInfo.groupId)
       if (link != null) {
         groupLink = link.first
         groupLinkMemberRole.value = link.second
@@ -62,7 +63,7 @@ fun GroupLinkView(
       val role = groupLinkMemberRole.value
       if (role != null) {
         withBGApi {
-          val link = chatModel.controller.apiGroupLinkMemberRole(groupInfo.groupId, role)
+          val link = chatModel.controller.apiGroupLinkMemberRole(rhId, groupInfo.groupId, role)
           if (link != null) {
             groupLink = link.first
             groupLinkMemberRole.value = link.second
@@ -78,7 +79,7 @@ fun GroupLinkView(
         confirmText = generalGetString(MR.strings.delete_verb),
         onConfirm = {
           withApi {
-            val r = chatModel.controller.apiDeleteGroupLink(groupInfo.groupId)
+            val r = chatModel.controller.apiDeleteGroupLink(rhId, groupInfo.groupId)
             if (r) {
               groupLink = null
               onGroupLinkUpdated?.invoke(null)
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupMemberInfoView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupMemberInfoView.kt
index 9f52f61de..00b236c7d 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupMemberInfoView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupMemberInfoView.kt
@@ -40,6 +40,7 @@ import kotlinx.datetime.Clock
 
 @Composable
 fun GroupMemberInfoView(
+  rhId: Long?,
   groupInfo: GroupInfo,
   member: GroupMember,
   connectionStats: ConnectionStats?,
@@ -49,7 +50,7 @@ fun GroupMemberInfoView(
   closeAll: () -> Unit, // Close all open windows up to ChatView
 ) {
   BackHandler(onBack = close)
-  val chat = chatModel.chats.firstOrNull { it.id == chatModel.chatId.value }
+  val chat = chatModel.chats.firstOrNull { ch -> ch.id == chatModel.chatId.value && ch.remoteHostId == rhId }
   val connStats = remember { mutableStateOf(connectionStats) }
   val developerTools = chatModel.controller.appPrefs.developerTools.get()
   var progressIndicator by remember { mutableStateOf(false) }
@@ -66,7 +67,7 @@ fun GroupMemberInfoView(
       getContactChat = { chatModel.getContactChat(it) },
       openDirectChat = {
         withApi {
-          val c = chatModel.controller.apiGetChat(ChatType.Direct, it)
+          val c = chatModel.controller.apiGetChat(rhId, ChatType.Direct, it)
           if (c != null) {
             if (chatModel.getContactChat(it) == null) {
               chatModel.addChat(c)
@@ -82,9 +83,9 @@ fun GroupMemberInfoView(
       createMemberContact = {
         withApi {
           progressIndicator = true
-          val memberContact = chatModel.controller.apiCreateMemberContact(groupInfo.apiId, member.groupMemberId)
+          val memberContact = chatModel.controller.apiCreateMemberContact(rhId, groupInfo.apiId, member.groupMemberId)
           if (memberContact != null) {
-            val memberChat = Chat(ChatInfo.Direct(memberContact), chatItems = arrayListOf())
+            val memberChat = Chat(remoteHostId = rhId, ChatInfo.Direct(memberContact), chatItems = arrayListOf())
             chatModel.addChat(memberChat)
             openLoadedChat(memberChat, chatModel)
             closeAll()
@@ -94,11 +95,11 @@ fun GroupMemberInfoView(
         }
       },
       connectViaAddress = { connReqUri ->
-        connectViaMemberAddressAlert(connReqUri)
+        connectViaMemberAddressAlert(rhId, connReqUri)
       },
-      blockMember = { blockMemberAlert(groupInfo, member) },
-      unblockMember = { unblockMemberAlert(groupInfo, member) },
-      removeMember = { removeMemberDialog(groupInfo, member, chatModel, close) },
+      blockMember = { blockMemberAlert(rhId, groupInfo, member) },
+      unblockMember = { unblockMemberAlert(rhId, groupInfo, member) },
+      removeMember = { removeMemberDialog(rhId, groupInfo, member, chatModel, close) },
       onRoleSelected = {
         if (it == newRole.value) return@GroupMemberInfoLayout
         val prevValue = newRole.value
@@ -108,8 +109,8 @@ fun GroupMemberInfoView(
         }) {
           withApi {
             kotlin.runCatching {
-              val mem = chatModel.controller.apiMemberRole(groupInfo.groupId, member.groupMemberId, it)
-              chatModel.upsertGroupMember(groupInfo, mem)
+              val mem = chatModel.controller.apiMemberRole(rhId, groupInfo.groupId, member.groupMemberId, it)
+              chatModel.upsertGroupMember(rhId, groupInfo, mem)
             }.onFailure {
               newRole.value = prevValue
             }
@@ -119,10 +120,10 @@ fun GroupMemberInfoView(
       switchMemberAddress = {
         showSwitchAddressAlert(switchAddress = {
           withApi {
-            val r = chatModel.controller.apiSwitchGroupMember(groupInfo.apiId, member.groupMemberId)
+            val r = chatModel.controller.apiSwitchGroupMember(rhId, groupInfo.apiId, member.groupMemberId)
             if (r != null) {
               connStats.value = r.second
-              chatModel.updateGroupMemberConnectionStats(groupInfo, r.first, r.second)
+              chatModel.updateGroupMemberConnectionStats(rhId, groupInfo, r.first, r.second)
               close.invoke()
             }
           }
@@ -131,10 +132,10 @@ fun GroupMemberInfoView(
       abortSwitchMemberAddress = {
         showAbortSwitchAddressAlert(abortSwitchAddress = {
           withApi {
-            val r = chatModel.controller.apiAbortSwitchGroupMember(groupInfo.apiId, member.groupMemberId)
+            val r = chatModel.controller.apiAbortSwitchGroupMember(rhId, groupInfo.apiId, member.groupMemberId)
             if (r != null) {
               connStats.value = r.second
-              chatModel.updateGroupMemberConnectionStats(groupInfo, r.first, r.second)
+              chatModel.updateGroupMemberConnectionStats(rhId, groupInfo, r.first, r.second)
               close.invoke()
             }
           }
@@ -142,10 +143,10 @@ fun GroupMemberInfoView(
       },
       syncMemberConnection = {
         withApi {
-          val r = chatModel.controller.apiSyncGroupMemberRatchet(groupInfo.apiId, member.groupMemberId, force = false)
+          val r = chatModel.controller.apiSyncGroupMemberRatchet(rhId, groupInfo.apiId, member.groupMemberId, force = false)
           if (r != null) {
             connStats.value = r.second
-            chatModel.updateGroupMemberConnectionStats(groupInfo, r.first, r.second)
+            chatModel.updateGroupMemberConnectionStats(rhId, groupInfo, r.first, r.second)
             close.invoke()
           }
         }
@@ -153,10 +154,10 @@ fun GroupMemberInfoView(
       syncMemberConnectionForce = {
         showSyncConnectionForceAlert(syncConnectionForce = {
           withApi {
-            val r = chatModel.controller.apiSyncGroupMemberRatchet(groupInfo.apiId, member.groupMemberId, force = true)
+            val r = chatModel.controller.apiSyncGroupMemberRatchet(rhId, groupInfo.apiId, member.groupMemberId, force = true)
             if (r != null) {
               connStats.value = r.second
-              chatModel.updateGroupMemberConnectionStats(groupInfo, r.first, r.second)
+              chatModel.updateGroupMemberConnectionStats(rhId, groupInfo, r.first, r.second)
               close.invoke()
             }
           }
@@ -170,9 +171,10 @@ fun GroupMemberInfoView(
               connectionCode,
               mem.verified,
               verify = { code ->
-                chatModel.controller.apiVerifyGroupMember(mem.groupId, mem.groupMemberId, code)?.let { r ->
+                chatModel.controller.apiVerifyGroupMember(rhId, mem.groupId, mem.groupMemberId, code)?.let { r ->
                   val (verified, existingCode) = r
                   chatModel.upsertGroupMember(
+                    rhId,
                     groupInfo,
                     mem.copy(
                       activeConn = mem.activeConn?.copy(
@@ -196,16 +198,16 @@ fun GroupMemberInfoView(
   }
 }
 
-fun removeMemberDialog(groupInfo: GroupInfo, member: GroupMember, chatModel: ChatModel, close: (() -> Unit)? = null) {
+fun removeMemberDialog(rhId: Long?, groupInfo: GroupInfo, member: GroupMember, chatModel: ChatModel, close: (() -> Unit)? = null) {
   AlertManager.shared.showAlertDialog(
     title = generalGetString(MR.strings.button_remove_member),
     text = generalGetString(MR.strings.member_will_be_removed_from_group_cannot_be_undone),
     confirmText = generalGetString(MR.strings.remove_member_confirmation),
     onConfirm = {
       withApi {
-        val removedMember = chatModel.controller.apiRemoveMember(member.groupId, member.groupMemberId)
+        val removedMember = chatModel.controller.apiRemoveMember(rhId, member.groupId, member.groupMemberId)
         if (removedMember != null) {
-          chatModel.upsertGroupMember(groupInfo, removedMember)
+          chatModel.upsertGroupMember(rhId, groupInfo, removedMember)
         }
         close?.invoke()
       }
@@ -500,11 +502,11 @@ private fun updateMemberRoleDialog(
   )
 }
 
-fun connectViaMemberAddressAlert(connReqUri: String) {
+fun connectViaMemberAddressAlert(rhId: Long?, connReqUri: String) {
   try {
     val uri = URI(connReqUri)
     withApi {
-      planAndConnect(chatModel, uri, incognito = null, close = { ModalManager.closeAllModalsEverywhere() })
+      planAndConnect(chatModel, rhId, uri, incognito = null, close = { ModalManager.closeAllModalsEverywhere() })
     }
   } catch (e: RuntimeException) {
     AlertManager.shared.showAlertMsg(
@@ -514,39 +516,39 @@ fun connectViaMemberAddressAlert(connReqUri: String) {
   }
 }
 
-fun blockMemberAlert(gInfo: GroupInfo, mem: GroupMember) {
+fun blockMemberAlert(rhId: Long?, gInfo: GroupInfo, mem: GroupMember) {
   AlertManager.shared.showAlertDialog(
     title = generalGetString(MR.strings.block_member_question),
     text = generalGetString(MR.strings.block_member_desc).format(mem.chatViewName),
     confirmText = generalGetString(MR.strings.block_member_confirmation),
     onConfirm = {
-      toggleShowMemberMessages(gInfo, mem, false)
+      toggleShowMemberMessages(rhId, gInfo, mem, false)
     },
     destructive = true,
   )
 }
 
-fun unblockMemberAlert(gInfo: GroupInfo, mem: GroupMember) {
+fun unblockMemberAlert(rhId: Long?, gInfo: GroupInfo, mem: GroupMember) {
   AlertManager.shared.showAlertDialog(
     title = generalGetString(MR.strings.unblock_member_question),
     text = generalGetString(MR.strings.unblock_member_desc).format(mem.chatViewName),
     confirmText = generalGetString(MR.strings.unblock_member_confirmation),
     onConfirm = {
-      toggleShowMemberMessages(gInfo, mem, true)
+      toggleShowMemberMessages(rhId, gInfo, mem, true)
     },
   )
 }
 
-fun toggleShowMemberMessages(gInfo: GroupInfo, member: GroupMember, showMessages: Boolean) {
+fun toggleShowMemberMessages(rhId: Long?, gInfo: GroupInfo, member: GroupMember, showMessages: Boolean) {
   val updatedMemberSettings = member.memberSettings.copy(showMessages = showMessages)
-  updateMemberSettings(gInfo, member, updatedMemberSettings)
+  updateMemberSettings(rhId, gInfo, member, updatedMemberSettings)
 }
 
-fun updateMemberSettings(gInfo: GroupInfo, member: GroupMember, memberSettings: GroupMemberSettings) {
+fun updateMemberSettings(rhId: Long?, gInfo: GroupInfo, member: GroupMember, memberSettings: GroupMemberSettings) {
   withBGApi {
-    val success = ChatController.apiSetMemberSettings(gInfo.groupId, member.groupMemberId, memberSettings)
+    val success = ChatController.apiSetMemberSettings(rhId, gInfo.groupId, member.groupMemberId, memberSettings)
     if (success) {
-      ChatModel.upsertGroupMember(gInfo, member.copy(memberSettings = memberSettings))
+      ChatModel.upsertGroupMember(rhId, gInfo, member.copy(memberSettings = memberSettings))
     }
   }
 }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupPreferences.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupPreferences.kt
index 4571a38c1..3cdfaad2d 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupPreferences.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupPreferences.kt
@@ -21,8 +21,12 @@ import chat.simplex.common.model.*
 import chat.simplex.res.MR
 
 @Composable
-fun GroupPreferencesView(m: ChatModel, chatId: String, close: () -> Unit,) {
-  val groupInfo = remember { derivedStateOf { (m.getChat(chatId)?.chatInfo as? ChatInfo.Group)?.groupInfo } }
+fun GroupPreferencesView(m: ChatModel, rhId: Long?, chatId: String, close: () -> Unit,) {
+  val groupInfo = remember { derivedStateOf {
+    val ch = m.getChat(chatId)
+    val g = (ch?.chatInfo as? ChatInfo.Group)?.groupInfo
+    if (g == null || ch?.remoteHostId != rhId) null else g
+  }}
   val gInfo = groupInfo.value ?: return
   var preferences by rememberSaveable(gInfo, stateSaver = serializableSaver()) { mutableStateOf(gInfo.fullGroupPreferences) }
   var currentPreferences by rememberSaveable(gInfo, stateSaver = serializableSaver()) { mutableStateOf(preferences) }
@@ -30,9 +34,9 @@ fun GroupPreferencesView(m: ChatModel, chatId: String, close: () -> Unit,) {
   fun savePrefs(afterSave: () -> Unit = {}) {
     withApi {
       val gp = gInfo.groupProfile.copy(groupPreferences = preferences.toGroupPreferences())
-      val g = m.controller.apiUpdateGroup(gInfo.groupId, gp)
+      val g = m.controller.apiUpdateGroup(rhId, gInfo.groupId, gp)
       if (g != null) {
-        m.updateGroup(g)
+        m.updateGroup(rhId, g)
         currentPreferences = preferences
       }
       afterSave()
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupProfileView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupProfileView.kt
index 5376cb092..f92fd88dc 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupProfileView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupProfileView.kt
@@ -30,15 +30,15 @@ import kotlinx.coroutines.launch
 import java.net.URI
 
 @Composable
-fun GroupProfileView(groupInfo: GroupInfo, chatModel: ChatModel, close: () -> Unit) {
+fun GroupProfileView(rhId: Long?, groupInfo: GroupInfo, chatModel: ChatModel, close: () -> Unit) {
   GroupProfileLayout(
     close = close,
     groupProfile = groupInfo.groupProfile,
     saveProfile = { p ->
       withApi {
-        val gInfo = chatModel.controller.apiUpdateGroup(groupInfo.groupId, p)
+        val gInfo = chatModel.controller.apiUpdateGroup(rhId, groupInfo.groupId, p)
         if (gInfo != null) {
-          chatModel.updateGroup(gInfo)
+          chatModel.updateGroup(rhId, gInfo)
           close.invoke()
         }
       }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/WelcomeMessageView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/WelcomeMessageView.kt
index 3be54376d..577c19648 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/WelcomeMessageView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/WelcomeMessageView.kt
@@ -30,7 +30,7 @@ import chat.simplex.res.MR
 import kotlinx.coroutines.delay
 
 @Composable
-fun GroupWelcomeView(m: ChatModel, groupInfo: GroupInfo, close: () -> Unit) {
+fun GroupWelcomeView(m: ChatModel, rhId: Long?, groupInfo: GroupInfo, close: () -> Unit) {
   var gInfo by remember { mutableStateOf(groupInfo) }
   val welcomeText = remember { mutableStateOf(gInfo.groupProfile.description ?: "") }
 
@@ -41,10 +41,10 @@ fun GroupWelcomeView(m: ChatModel, groupInfo: GroupInfo, close: () -> Unit) {
         welcome = null
       }
       val groupProfileUpdated = gInfo.groupProfile.copy(description = welcome)
-      val res = m.controller.apiUpdateGroup(gInfo.groupId, groupProfileUpdated)
+      val res = m.controller.apiUpdateGroup(rhId, gInfo.groupId, groupProfileUpdated)
       if (res != null) {
         gInfo = res
-        m.updateGroup(res)
+        m.updateGroup(rhId, res)
         welcomeText.value = welcome ?: ""
       }
       afterSave()
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt
index 13380a664..7e81faf3d 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt
@@ -62,7 +62,7 @@ fun ChatListNavLinkView(chat: Chat, chatModel: ChatModel) {
       val contactNetworkStatus = chatModel.contactNetworkStatus(chat.chatInfo.contact)
       ChatListNavLinkLayout(
         chatLinkPreview = { ChatPreviewView(chat, showChatPreviews, chatModel.draft.value, chatModel.draftChatId.value, chatModel.currentUser.value?.profile?.displayName, contactNetworkStatus, stopped, linkMode, inProgress = false, progressByTimeout = false) },
-        click = { directChatAction(chat.chatInfo.contact, chatModel) },
+        click = { directChatAction(chat.remoteHostId, chat.chatInfo.contact, chatModel) },
         dropdownMenuItems = { ContactMenuItems(chat, chat.chatInfo.contact, chatModel, showMenu, showMarkRead) },
         showMenu,
         stopped,
@@ -72,7 +72,7 @@ fun ChatListNavLinkView(chat: Chat, chatModel: ChatModel) {
     is ChatInfo.Group ->
       ChatListNavLinkLayout(
         chatLinkPreview = { ChatPreviewView(chat, showChatPreviews, chatModel.draft.value, chatModel.draftChatId.value, chatModel.currentUser.value?.profile?.displayName, null, stopped, linkMode, inProgress.value, progressByTimeout) },
-        click = { if (!inProgress.value) groupChatAction(chat.chatInfo.groupInfo, chatModel, inProgress) },
+        click = { if (!inProgress.value) groupChatAction(chat.remoteHostId, chat.chatInfo.groupInfo, chatModel, inProgress) },
         dropdownMenuItems = { GroupMenuItems(chat, chat.chatInfo.groupInfo, chatModel, showMenu, inProgress, showMarkRead) },
         showMenu,
         stopped,
@@ -81,8 +81,8 @@ fun ChatListNavLinkView(chat: Chat, chatModel: ChatModel) {
     is ChatInfo.ContactRequest ->
       ChatListNavLinkLayout(
         chatLinkPreview = { ContactRequestView(chat.chatInfo) },
-        click = { contactRequestAlertDialog(chat.chatInfo, chatModel) },
-        dropdownMenuItems = { ContactRequestMenuItems(chat.chatInfo, chatModel, showMenu) },
+        click = { contactRequestAlertDialog(chat.remoteHostId, chat.chatInfo, chatModel) },
+        dropdownMenuItems = { ContactRequestMenuItems(chat.remoteHostId, chat.chatInfo, chatModel, showMenu) },
         showMenu,
         stopped,
         selectedChat
@@ -94,10 +94,10 @@ fun ChatListNavLinkView(chat: Chat, chatModel: ChatModel) {
           ModalManager.center.closeModals()
           ModalManager.end.closeModals()
           ModalManager.center.showModalCloseable(true, showClose = appPlatform.isAndroid) { close ->
-            ContactConnectionInfoView(chatModel, chat.chatInfo.contactConnection.connReqInv, chat.chatInfo.contactConnection, false, close)
+            ContactConnectionInfoView(chatModel, chat.remoteHostId, chat.chatInfo.contactConnection.connReqInv, chat.chatInfo.contactConnection, false, close)
           }
         },
-        dropdownMenuItems = { ContactConnectionMenuItems(chat.chatInfo, chatModel, showMenu) },
+        dropdownMenuItems = { ContactConnectionMenuItems(chat.remoteHostId, chat.chatInfo, chatModel, showMenu) },
         showMenu,
         stopped,
         selectedChat
@@ -119,38 +119,38 @@ fun ChatListNavLinkView(chat: Chat, chatModel: ChatModel) {
   }
 }
 
-fun directChatAction(contact: Contact, chatModel: ChatModel) {
+fun directChatAction(rhId: Long?, contact: Contact, chatModel: ChatModel) {
   when {
-    contact.activeConn == null && contact.profile.contactLink != null -> askCurrentOrIncognitoProfileConnectContactViaAddress(chatModel, contact, close = null, openChat = true)
-    else -> withBGApi { openChat(ChatInfo.Direct(contact), chatModel) }
+    contact.activeConn == null && contact.profile.contactLink != null -> askCurrentOrIncognitoProfileConnectContactViaAddress(chatModel, rhId, contact, close = null, openChat = true)
+    else -> withBGApi { openChat(rhId, ChatInfo.Direct(contact), chatModel) }
   }
 }
 
-fun groupChatAction(groupInfo: GroupInfo, chatModel: ChatModel, inProgress: MutableState<Boolean>? = null) {
+fun groupChatAction(rhId: Long?, groupInfo: GroupInfo, chatModel: ChatModel, inProgress: MutableState<Boolean>? = null) {
   when (groupInfo.membership.memberStatus) {
-    GroupMemberStatus.MemInvited -> acceptGroupInvitationAlertDialog(groupInfo, chatModel, inProgress)
+    GroupMemberStatus.MemInvited -> acceptGroupInvitationAlertDialog(rhId, groupInfo, chatModel, inProgress)
     GroupMemberStatus.MemAccepted -> groupInvitationAcceptedAlert()
-    else -> withBGApi { openChat(ChatInfo.Group(groupInfo), chatModel) }
+    else -> withBGApi { openChat(rhId, ChatInfo.Group(groupInfo), chatModel) }
   }
 }
 
-suspend fun openDirectChat(contactId: Long, chatModel: ChatModel) {
-  val chat = chatModel.controller.apiGetChat(ChatType.Direct, contactId)
+suspend fun openDirectChat(rhId: Long?, contactId: Long, chatModel: ChatModel) {
+  val chat = chatModel.controller.apiGetChat(rhId, ChatType.Direct, contactId)
   if (chat != null) {
     openLoadedChat(chat, chatModel)
   }
 }
 
-suspend fun openGroupChat(groupId: Long, chatModel: ChatModel) {
-  val chat = chatModel.controller.apiGetChat(ChatType.Group, groupId)
+suspend fun openGroupChat(rhId: Long?, groupId: Long, chatModel: ChatModel) {
+  val chat = chatModel.controller.apiGetChat(rhId, ChatType.Group, groupId)
   if (chat != null) {
     openLoadedChat(chat, chatModel)
   }
 }
 
-suspend fun openChat(chatInfo: ChatInfo, chatModel: ChatModel) {
+suspend fun openChat(rhId: Long?, chatInfo: ChatInfo, chatModel: ChatModel) {
   Log.d(TAG, "TODOCHAT: openChat: opening ${chatInfo.id}, current chatId ${ChatModel.chatId.value}, size ${ChatModel.chatItems.size}")
-  val chat = chatModel.controller.apiGetChat(chatInfo.chatType, chatInfo.apiId)
+  val chat = chatModel.controller.apiGetChat(rhId, chatInfo.chatType, chatInfo.apiId)
   if (chat != null) {
     openLoadedChat(chat, chatModel)
     Log.d(TAG, "TODOCHAT: openChat: opened ${chatInfo.id}, current chatId ${ChatModel.chatId.value}, size ${ChatModel.chatItems.size}")
@@ -164,22 +164,24 @@ fun openLoadedChat(chat: Chat, chatModel: ChatModel) {
   chatModel.chatId.value = chat.chatInfo.id
 }
 
-suspend fun apiLoadPrevMessages(chatInfo: ChatInfo, chatModel: ChatModel, beforeChatItemId: Long, search: String) {
+suspend fun apiLoadPrevMessages(ch: Chat, chatModel: ChatModel, beforeChatItemId: Long, search: String) {
+  val chatInfo = ch.chatInfo
   val pagination = ChatPagination.Before(beforeChatItemId, ChatPagination.PRELOAD_COUNT)
-  val chat = chatModel.controller.apiGetChat(chatInfo.chatType, chatInfo.apiId, pagination, search) ?: return
+  val chat = chatModel.controller.apiGetChat(ch.remoteHostId, chatInfo.chatType, chatInfo.apiId, pagination, search) ?: return
   if (chatModel.chatId.value != chat.id) return
   chatModel.chatItems.addAll(0, chat.chatItems)
 }
 
-suspend fun apiFindMessages(chatInfo: ChatInfo, chatModel: ChatModel, search: String) {
-  val chat = chatModel.controller.apiGetChat(chatInfo.chatType, chatInfo.apiId, search = search) ?: return
+suspend fun apiFindMessages(ch: Chat, chatModel: ChatModel, search: String) {
+  val chatInfo = ch.chatInfo
+  val chat = chatModel.controller.apiGetChat(ch.remoteHostId, chatInfo.chatType, chatInfo.apiId, search = search) ?: return
   if (chatModel.chatId.value != chat.id) return
   chatModel.chatItems.clear()
   chatModel.chatItems.addAll(0, chat.chatItems)
 }
 
-suspend fun setGroupMembers(groupInfo: GroupInfo, chatModel: ChatModel) {
-  val groupMembers = chatModel.controller.apiListMembers(groupInfo.groupId)
+suspend fun setGroupMembers(rhId: Long?, groupInfo: GroupInfo, chatModel: ChatModel) {
+  val groupMembers = chatModel.controller.apiListMembers(rhId, groupInfo.groupId)
   val currentMembers = chatModel.groupMembers
   val newMembers = groupMembers.map { newMember ->
     val currentMember = currentMembers.find { it.id == newMember.id }
@@ -230,7 +232,7 @@ fun GroupMenuItems(
     }
     GroupMemberStatus.MemAccepted -> {
       if (groupInfo.membership.memberCurrent) {
-        LeaveGroupAction(groupInfo, chatModel, showMenu)
+        LeaveGroupAction(chat.remoteHostId, groupInfo, chatModel, showMenu)
       }
       if (groupInfo.canDelete) {
         DeleteGroupAction(chat, groupInfo, chatModel, showMenu)
@@ -246,7 +248,7 @@ fun GroupMenuItems(
       ToggleNotificationsChatAction(chat, chatModel, chat.chatInfo.ntfsEnabled, showMenu)
       ClearChatAction(chat, chatModel, showMenu)
       if (groupInfo.membership.memberCurrent) {
-        LeaveGroupAction(groupInfo, chatModel, showMenu)
+        LeaveGroupAction(chat.remoteHostId, groupInfo, chatModel, showMenu)
       }
       if (groupInfo.canDelete) {
         DeleteGroupAction(chat, groupInfo, chatModel, showMenu)
@@ -310,7 +312,7 @@ fun ClearChatAction(chat: Chat, chatModel: ChatModel, showMenu: MutableState<Boo
     stringResource(MR.strings.clear_chat_menu_action),
     painterResource(MR.images.ic_settings_backup_restore),
     onClick = {
-      clearChatDialog(chat.chatInfo, chatModel)
+      clearChatDialog(chat, chatModel)
       showMenu.value = false
     },
     color = WarningOrange
@@ -323,7 +325,7 @@ fun DeleteContactAction(chat: Chat, chatModel: ChatModel, showMenu: MutableState
     stringResource(MR.strings.delete_contact_menu_action),
     painterResource(MR.images.ic_delete),
     onClick = {
-      deleteContactDialog(chat.chatInfo, chatModel)
+      deleteContactDialog(chat, chatModel)
       showMenu.value = false
     },
     color = Color.Red
@@ -336,7 +338,7 @@ fun DeleteGroupAction(chat: Chat, groupInfo: GroupInfo, chatModel: ChatModel, sh
     stringResource(MR.strings.delete_group_menu_action),
     painterResource(MR.images.ic_delete),
     onClick = {
-      deleteGroupDialog(chat.chatInfo, groupInfo, chatModel)
+      deleteGroupDialog(chat, groupInfo, chatModel)
       showMenu.value = false
     },
     color = Color.Red
@@ -354,7 +356,7 @@ fun JoinGroupAction(
   val joinGroup: () -> Unit = {
     withApi {
       inProgress.value = true
-      chatModel.controller.apiJoinGroup(groupInfo.groupId)
+      chatModel.controller.apiJoinGroup(chat.remoteHostId, groupInfo.groupId)
       inProgress.value = false
     }
   }
@@ -370,12 +372,12 @@ fun JoinGroupAction(
 }
 
 @Composable
-fun LeaveGroupAction(groupInfo: GroupInfo, chatModel: ChatModel, showMenu: MutableState<Boolean>) {
+fun LeaveGroupAction(rhId: Long?, groupInfo: GroupInfo, chatModel: ChatModel, showMenu: MutableState<Boolean>) {
   ItemAction(
     stringResource(MR.strings.leave_group_button),
     painterResource(MR.images.ic_logout),
     onClick = {
-      leaveGroupDialog(groupInfo, chatModel)
+      leaveGroupDialog(rhId, groupInfo, chatModel)
       showMenu.value = false
     },
     color = Color.Red
@@ -383,13 +385,13 @@ fun LeaveGroupAction(groupInfo: GroupInfo, chatModel: ChatModel, showMenu: Mutab
 }
 
 @Composable
-fun ContactRequestMenuItems(chatInfo: ChatInfo.ContactRequest, chatModel: ChatModel, showMenu: MutableState<Boolean>) {
+fun ContactRequestMenuItems(rhId: Long?, chatInfo: ChatInfo.ContactRequest, chatModel: ChatModel, showMenu: MutableState<Boolean>) {
   ItemAction(
     stringResource(MR.strings.accept_contact_button),
     painterResource(MR.images.ic_check),
     color = MaterialTheme.colors.onBackground,
     onClick = {
-      acceptContactRequest(incognito = false, chatInfo.apiId, chatInfo, true, chatModel)
+      acceptContactRequest(rhId, incognito = false, chatInfo.apiId, chatInfo, true, chatModel)
       showMenu.value = false
     }
   )
@@ -398,7 +400,7 @@ fun ContactRequestMenuItems(chatInfo: ChatInfo.ContactRequest, chatModel: ChatMo
     painterResource(MR.images.ic_theater_comedy),
     color = MaterialTheme.colors.onBackground,
     onClick = {
-      acceptContactRequest(incognito = true, chatInfo.apiId, chatInfo, true, chatModel)
+      acceptContactRequest(rhId, incognito = true, chatInfo.apiId, chatInfo, true, chatModel)
       showMenu.value = false
     }
   )
@@ -406,7 +408,7 @@ fun ContactRequestMenuItems(chatInfo: ChatInfo.ContactRequest, chatModel: ChatMo
     stringResource(MR.strings.reject_contact_button),
     painterResource(MR.images.ic_close),
     onClick = {
-      rejectContactRequest(chatInfo, chatModel)
+      rejectContactRequest(rhId, chatInfo, chatModel)
       showMenu.value = false
     },
     color = Color.Red
@@ -414,7 +416,7 @@ fun ContactRequestMenuItems(chatInfo: ChatInfo.ContactRequest, chatModel: ChatMo
 }
 
 @Composable
-fun ContactConnectionMenuItems(chatInfo: ChatInfo.ContactConnection, chatModel: ChatModel, showMenu: MutableState<Boolean>) {
+fun ContactConnectionMenuItems(rhId: Long?, chatInfo: ChatInfo.ContactConnection, chatModel: ChatModel, showMenu: MutableState<Boolean>) {
   ItemAction(
     stringResource(MR.strings.set_contact_name),
     painterResource(MR.images.ic_edit),
@@ -422,7 +424,7 @@ fun ContactConnectionMenuItems(chatInfo: ChatInfo.ContactConnection, chatModel:
       ModalManager.center.closeModals()
       ModalManager.end.closeModals()
       ModalManager.center.showModalCloseable(true, showClose = appPlatform.isAndroid) { close ->
-        ContactConnectionInfoView(chatModel, chatInfo.contactConnection.connReqInv, chatInfo.contactConnection, true, close)
+        ContactConnectionInfoView(chatModel, rhId, chatInfo.contactConnection.connReqInv, chatInfo.contactConnection, true, close)
       }
       showMenu.value = false
     },
@@ -431,7 +433,7 @@ fun ContactConnectionMenuItems(chatInfo: ChatInfo.ContactConnection, chatModel:
     stringResource(MR.strings.delete_verb),
     painterResource(MR.images.ic_delete),
     onClick = {
-      deleteContactConnectionAlert(chatInfo.contactConnection, chatModel) {
+      deleteContactConnectionAlert(rhId, chatInfo.contactConnection, chatModel) {
         if (chatModel.chatId.value == null) {
           ModalManager.center.closeModals()
           ModalManager.end.closeModals()
@@ -471,8 +473,9 @@ fun markChatRead(c: Chat, chatModel: ChatModel) {
   withApi {
     if (chat.chatStats.unreadCount > 0) {
       val minUnreadItemId = chat.chatStats.minUnreadItemId
-      chatModel.markChatItemsRead(chat.chatInfo)
+      chatModel.markChatItemsRead(chat)
       chatModel.controller.apiChatRead(
+        chat.remoteHostId,
         chat.chatInfo.chatType,
         chat.chatInfo.apiId,
         CC.ItemRange(minUnreadItemId, chat.chatItems.last().id)
@@ -481,12 +484,13 @@ fun markChatRead(c: Chat, chatModel: ChatModel) {
     }
     if (chat.chatStats.unreadChat) {
       val success = chatModel.controller.apiChatUnread(
+        chat.remoteHostId,
         chat.chatInfo.chatType,
         chat.chatInfo.apiId,
         false
       )
       if (success) {
-        chatModel.replaceChat(chat.id, chat.copy(chatStats = chat.chatStats.copy(unreadChat = false)))
+        chatModel.replaceChat(chat.remoteHostId, chat.id, chat.copy(chatStats = chat.chatStats.copy(unreadChat = false)))
       }
     }
   }
@@ -498,17 +502,18 @@ fun markChatUnread(chat: Chat, chatModel: ChatModel) {
 
   withApi {
     val success = chatModel.controller.apiChatUnread(
+      chat.remoteHostId,
       chat.chatInfo.chatType,
       chat.chatInfo.apiId,
       true
     )
     if (success) {
-      chatModel.replaceChat(chat.id, chat.copy(chatStats = chat.chatStats.copy(unreadChat = true)))
+      chatModel.replaceChat(chat.remoteHostId, chat.id, chat.copy(chatStats = chat.chatStats.copy(unreadChat = true)))
     }
   }
 }
 
-fun contactRequestAlertDialog(contactRequest: ChatInfo.ContactRequest, chatModel: ChatModel) {
+fun contactRequestAlertDialog(rhId: Long?, contactRequest: ChatInfo.ContactRequest, chatModel: ChatModel) {
   AlertManager.shared.showAlertDialogButtonsColumn(
     title = generalGetString(MR.strings.accept_connection_request__question),
     text = AnnotatedString(generalGetString(MR.strings.if_you_choose_to_reject_the_sender_will_not_be_notified)),
@@ -516,19 +521,19 @@ fun contactRequestAlertDialog(contactRequest: ChatInfo.ContactRequest, chatModel
       Column {
         SectionItemView({
           AlertManager.shared.hideAlert()
-          acceptContactRequest(incognito = false, contactRequest.apiId, contactRequest, true, chatModel)
+          acceptContactRequest(rhId, incognito = false, contactRequest.apiId, contactRequest, true, chatModel)
         }) {
           Text(generalGetString(MR.strings.accept_contact_button), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = MaterialTheme.colors.primary)
         }
         SectionItemView({
           AlertManager.shared.hideAlert()
-          acceptContactRequest(incognito = true, contactRequest.apiId, contactRequest, true, chatModel)
+          acceptContactRequest(rhId, incognito = true, contactRequest.apiId, contactRequest, true, chatModel)
         }) {
           Text(generalGetString(MR.strings.accept_contact_incognito_button), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = MaterialTheme.colors.primary)
         }
         SectionItemView({
           AlertManager.shared.hideAlert()
-          rejectContactRequest(contactRequest, chatModel)
+          rejectContactRequest(rhId, contactRequest, chatModel)
         }) {
           Text(generalGetString(MR.strings.reject_contact_button), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = Color.Red)
         }
@@ -537,24 +542,24 @@ fun contactRequestAlertDialog(contactRequest: ChatInfo.ContactRequest, chatModel
   )
 }
 
-fun acceptContactRequest(incognito: Boolean, apiId: Long, contactRequest: ChatInfo.ContactRequest?, isCurrentUser: Boolean, chatModel: ChatModel) {
+fun acceptContactRequest(rhId: Long?, incognito: Boolean, apiId: Long, contactRequest: ChatInfo.ContactRequest?, isCurrentUser: Boolean, chatModel: ChatModel) {
   withApi {
-    val contact = chatModel.controller.apiAcceptContactRequest(incognito, apiId)
+    val contact = chatModel.controller.apiAcceptContactRequest(rhId, incognito, apiId)
     if (contact != null && isCurrentUser && contactRequest != null) {
-      val chat = Chat(ChatInfo.Direct(contact), listOf())
-      chatModel.replaceChat(contactRequest.id, chat)
+      val chat = Chat(remoteHostId = rhId, ChatInfo.Direct(contact), listOf())
+      chatModel.replaceChat(rhId, contactRequest.id, chat)
     }
   }
 }
 
-fun rejectContactRequest(contactRequest: ChatInfo.ContactRequest, chatModel: ChatModel) {
+fun rejectContactRequest(rhId: Long?, contactRequest: ChatInfo.ContactRequest, chatModel: ChatModel) {
   withApi {
-    chatModel.controller.apiRejectContactRequest(contactRequest.apiId)
-    chatModel.removeChat(contactRequest.id)
+    chatModel.controller.apiRejectContactRequest(rhId, contactRequest.apiId)
+    chatModel.removeChat(rhId, contactRequest.id)
   }
 }
 
-fun deleteContactConnectionAlert(connection: PendingContactConnection, chatModel: ChatModel, onSuccess: () -> Unit) {
+fun deleteContactConnectionAlert(rhId: Long?, connection: PendingContactConnection, chatModel: ChatModel, onSuccess: () -> Unit) {
   AlertManager.shared.showAlertDialog(
     title = generalGetString(MR.strings.delete_pending_connection__question),
     text = generalGetString(
@@ -565,8 +570,8 @@ fun deleteContactConnectionAlert(connection: PendingContactConnection, chatModel
     onConfirm = {
       withApi {
         AlertManager.shared.hideAlert()
-        if (chatModel.controller.apiDeleteChat(ChatType.ContactConnection, connection.apiId)) {
-          chatModel.removeChat(connection.id)
+        if (chatModel.controller.apiDeleteChat(rhId, ChatType.ContactConnection, connection.apiId)) {
+          chatModel.removeChat(rhId, connection.id)
           onSuccess()
         }
       }
@@ -575,16 +580,17 @@ fun deleteContactConnectionAlert(connection: PendingContactConnection, chatModel
   )
 }
 
-fun pendingContactAlertDialog(chatInfo: ChatInfo, chatModel: ChatModel) {
+// TODO why is it not used
+fun pendingContactAlertDialog(rhId: Long?, chatInfo: ChatInfo, chatModel: ChatModel) {
   AlertManager.shared.showAlertDialog(
     title = generalGetString(MR.strings.alert_title_contact_connection_pending),
     text = generalGetString(MR.strings.alert_text_connection_pending_they_need_to_be_online_can_delete_and_retry),
     confirmText = generalGetString(MR.strings.button_delete_contact),
     onConfirm = {
       withApi {
-        val r = chatModel.controller.apiDeleteChat(chatInfo.chatType, chatInfo.apiId)
+        val r = chatModel.controller.apiDeleteChat(rhId, chatInfo.chatType, chatInfo.apiId)
         if (r) {
-          chatModel.removeChat(chatInfo.id)
+          chatModel.removeChat(rhId, chatInfo.id)
           if (chatModel.chatId.value == chatInfo.id) {
             chatModel.chatId.value = null
             ModalManager.end.closeModals()
@@ -599,6 +605,7 @@ fun pendingContactAlertDialog(chatInfo: ChatInfo, chatModel: ChatModel) {
 
 fun askCurrentOrIncognitoProfileConnectContactViaAddress(
   chatModel: ChatModel,
+  rhId: Long?,
   contact: Contact,
   close: (() -> Unit)?,
   openChat: Boolean
@@ -611,9 +618,9 @@ fun askCurrentOrIncognitoProfileConnectContactViaAddress(
           AlertManager.shared.hideAlert()
           withApi {
             close?.invoke()
-            val ok = connectContactViaAddress(chatModel, contact.contactId, incognito = false)
+            val ok = connectContactViaAddress(chatModel, rhId, contact.contactId, incognito = false)
             if (ok && openChat) {
-              openDirectChat(contact.contactId, chatModel)
+              openDirectChat(rhId, contact.contactId, chatModel)
             }
           }
         }) {
@@ -623,9 +630,9 @@ fun askCurrentOrIncognitoProfileConnectContactViaAddress(
           AlertManager.shared.hideAlert()
           withApi {
             close?.invoke()
-            val ok = connectContactViaAddress(chatModel, contact.contactId, incognito = true)
+            val ok = connectContactViaAddress(chatModel, rhId, contact.contactId, incognito = true)
             if (ok && openChat) {
-              openDirectChat(contact.contactId, chatModel)
+              openDirectChat(rhId, contact.contactId, chatModel)
             }
           }
         }) {
@@ -641,10 +648,10 @@ fun askCurrentOrIncognitoProfileConnectContactViaAddress(
   )
 }
 
-suspend fun connectContactViaAddress(chatModel: ChatModel, contactId: Long, incognito: Boolean): Boolean {
-  val contact = chatModel.controller.apiConnectContactViaAddress(incognito, contactId)
+suspend fun connectContactViaAddress(chatModel: ChatModel, rhId: Long?, contactId: Long, incognito: Boolean): Boolean {
+  val contact = chatModel.controller.apiConnectContactViaAddress(rhId, incognito, contactId)
   if (contact != null) {
-    chatModel.updateContact(contact)
+    chatModel.updateContact(rhId, contact)
     AlertManager.shared.showAlertMsg(
       title = generalGetString(MR.strings.connection_request_sent),
       text = generalGetString(MR.strings.you_will_be_connected_when_your_connection_request_is_accepted)
@@ -654,7 +661,7 @@ suspend fun connectContactViaAddress(chatModel: ChatModel, contactId: Long, inco
   return false
 }
 
-fun acceptGroupInvitationAlertDialog(groupInfo: GroupInfo, chatModel: ChatModel, inProgress: MutableState<Boolean>? = null) {
+fun acceptGroupInvitationAlertDialog(rhId: Long?, groupInfo: GroupInfo, chatModel: ChatModel, inProgress: MutableState<Boolean>? = null) {
   AlertManager.shared.showAlertDialog(
     title = generalGetString(MR.strings.join_group_question),
     text = generalGetString(MR.strings.you_are_invited_to_group_join_to_connect_with_group_members),
@@ -662,12 +669,12 @@ fun acceptGroupInvitationAlertDialog(groupInfo: GroupInfo, chatModel: ChatModel,
     onConfirm = {
       withApi {
         inProgress?.value = true
-        chatModel.controller.apiJoinGroup(groupInfo.groupId)
+        chatModel.controller.apiJoinGroup(rhId, groupInfo.groupId)
         inProgress?.value = false
       }
     },
     dismissText = generalGetString(MR.strings.delete_verb),
-    onDismiss = { deleteGroup(groupInfo, chatModel) }
+    onDismiss = { deleteGroup(rhId, groupInfo, chatModel) }
   )
 }
 
@@ -679,11 +686,11 @@ fun cantInviteIncognitoAlert() {
   )
 }
 
-fun deleteGroup(groupInfo: GroupInfo, chatModel: ChatModel) {
+fun deleteGroup(rhId: Long?, groupInfo: GroupInfo, chatModel: ChatModel) {
   withApi {
-    val r = chatModel.controller.apiDeleteChat(ChatType.Group, groupInfo.apiId)
+    val r = chatModel.controller.apiDeleteChat(rhId, ChatType.Group, groupInfo.apiId)
     if (r) {
-      chatModel.removeChat(groupInfo.id)
+      chatModel.removeChat(rhId, groupInfo.id)
       if (chatModel.chatId.value == groupInfo.id) {
         chatModel.chatId.value = null
         ModalManager.end.closeModals()
@@ -723,15 +730,15 @@ fun updateChatSettings(chat: Chat, chatSettings: ChatSettings, chatModel: ChatMo
   withApi {
     val res = when (newChatInfo) {
       is ChatInfo.Direct -> with(newChatInfo) {
-        chatModel.controller.apiSetSettings(chatType, apiId, contact.chatSettings)
+        chatModel.controller.apiSetSettings(chat.remoteHostId, chatType, apiId, contact.chatSettings)
       }
       is ChatInfo.Group -> with(newChatInfo) {
-        chatModel.controller.apiSetSettings(chatType, apiId, groupInfo.chatSettings)
+        chatModel.controller.apiSetSettings(chat.remoteHostId, chatType, apiId, groupInfo.chatSettings)
       }
       else -> false
     }
     if (res && newChatInfo != null) {
-      chatModel.updateChatInfo(newChatInfo)
+      chatModel.updateChatInfo(chat.remoteHostId, newChatInfo)
       if (chatSettings.enableNtfs != MsgFilter.All) {
         ntfManager.cancelNotificationsForChat(chat.id)
       }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt
index 7883a7a73..1644d286f 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt
@@ -53,7 +53,7 @@ fun ChatListView(chatModel: ChatModel, settingsState: SettingsViewState, setPerf
     val url = chatModel.appOpenUrl.value
     if (url != null) {
       chatModel.appOpenUrl.value = null
-      connectIfOpenedViaUri(url, chatModel)
+      connectIfOpenedViaUri(chatModel.remoteHostId, url, chatModel)
     }
   }
   if (appPlatform.isDesktop) {
@@ -117,7 +117,8 @@ fun ChatListView(chatModel: ChatModel, settingsState: SettingsViewState, setPerf
   }
   if (searchInList.isEmpty()) {
     DesktopActiveCallOverlayLayout(newChatSheetState)
-    NewChatSheet(chatModel, newChatSheetState, stopped, hideNewChatSheet)
+    // TODO disable this button and sheet for the duration of the switch
+    NewChatSheet(chatModel, chatModel.remoteHostId, newChatSheetState, stopped, hideNewChatSheet)
   }
   if (appPlatform.isAndroid) {
     UserPicker(chatModel, userPickerState, switchingUsersAndHosts) {
@@ -317,13 +318,13 @@ private fun ProgressIndicator() {
 @Composable
 expect fun DesktopActiveCallOverlayLayout(newChatSheetState: MutableStateFlow<AnimatedViewState>)
 
-fun connectIfOpenedViaUri(uri: URI, chatModel: ChatModel) {
+fun connectIfOpenedViaUri(rhId: Long?, uri: URI, chatModel: ChatModel) {
   Log.d(TAG, "connectIfOpenedViaUri: opened via link")
   if (chatModel.currentUser.value == null) {
     chatModel.appOpenUrl.value = uri
   } else {
     withApi {
-      planAndConnect(chatModel, uri, incognito = null, close = null)
+      planAndConnect(chatModel, rhId, uri, incognito = null, close = null)
     }
   }
 }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListNavLinkView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListNavLinkView.kt
index e423a591d..ad8f93990 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListNavLinkView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListNavLinkView.kt
@@ -20,13 +20,13 @@ fun ShareListNavLinkView(chat: Chat, chatModel: ChatModel) {
     is ChatInfo.Direct ->
       ShareListNavLinkLayout(
         chatLinkPreview = { SharePreviewView(chat) },
-        click = { directChatAction(chat.chatInfo.contact, chatModel) },
+        click = { directChatAction(chat.remoteHostId, chat.chatInfo.contact, chatModel) },
         stopped
       )
     is ChatInfo.Group ->
       ShareListNavLinkLayout(
         chatLinkPreview = { SharePreviewView(chat) },
-        click = { groupChatAction(chat.chatInfo.groupInfo, chatModel) },
+        click = { groupChatAction(chat.remoteHostId, chat.chatInfo.groupInfo, chatModel) },
         stopped
       )
     is ChatInfo.ContactRequest, is ChatInfo.ContactConnection, is ChatInfo.InvalidJSON -> {}
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt
index caf8ec5cb..20e856df6 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/UserPicker.kt
@@ -84,7 +84,7 @@ fun UserPicker(
       .filter { it }
       .collect {
         try {
-          val updatedUsers = chatModel.controller.listUsers().sortedByDescending { it.user.activeUser }
+          val updatedUsers = chatModel.controller.listUsers(chatModel.remoteHostId).sortedByDescending { it.user.activeUser }
           var same = users.size == updatedUsers.size
           if (same) {
             for (i in 0 until minOf(users.size, updatedUsers.size)) {
@@ -129,7 +129,7 @@ fun UserPicker(
               switchingUsersAndHosts.value = true
             }
             ModalManager.closeAllModalsEverywhere()
-            chatModel.controller.changeActiveUser(u.user.userId, null)
+            chatModel.controller.changeActiveUser(u.user.remoteHostId, u.user.userId, null)
             job.cancel()
             switchingUsersAndHosts.value = false
           }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/database/DatabaseView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/database/DatabaseView.kt
index 0cca35474..1f4be2966 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/database/DatabaseView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/database/DatabaseView.kt
@@ -65,6 +65,8 @@ fun DatabaseView(
   Box(
     Modifier.fillMaxSize(),
   ) {
+    val user = m.currentUser.value
+    val rhId = user?.remoteHostId
     DatabaseLayout(
       progressIndicator.value,
       remember { m.chatRunning }.value != false,
@@ -80,7 +82,7 @@ fun DatabaseView(
       chatLastStart,
       appFilesCountAndSize,
       chatItemTTL,
-      m.currentUser.value,
+      user,
       m.users,
       startChat = { startChat(m, chatLastStart, m.chatDbChanged) },
       stopChatAlert = { stopChatAlert(m) },
@@ -91,9 +93,9 @@ fun DatabaseView(
         val oldValue = chatItemTTL.value
         chatItemTTL.value = it
         if (it < oldValue) {
-          setChatItemTTLAlert(m, chatItemTTL, progressIndicator, appFilesCountAndSize)
+          setChatItemTTLAlert(m, rhId, chatItemTTL, progressIndicator, appFilesCountAndSize)
         } else if (it != oldValue) {
-          setCiTTL(m, chatItemTTL, progressIndicator, appFilesCountAndSize)
+          setCiTTL(m, rhId, chatItemTTL, progressIndicator, appFilesCountAndSize)
         }
       },
       showSettingsModal
@@ -265,7 +267,7 @@ fun DatabaseLayout(
 }
 
 private fun setChatItemTTLAlert(
-  m: ChatModel, selectedChatItemTTL: MutableState<ChatItemTTL>,
+  m: ChatModel, rhId: Long?, selectedChatItemTTL: MutableState<ChatItemTTL>,
   progressIndicator: MutableState<Boolean>,
   appFilesCountAndSize: MutableState<Pair<Int, Long>>,
 ) {
@@ -273,7 +275,7 @@ private fun setChatItemTTLAlert(
     title = generalGetString(MR.strings.enable_automatic_deletion_question),
     text = generalGetString(MR.strings.enable_automatic_deletion_message),
     confirmText = generalGetString(MR.strings.delete_messages),
-    onConfirm = { setCiTTL(m, selectedChatItemTTL, progressIndicator, appFilesCountAndSize) },
+    onConfirm = { setCiTTL(m, rhId, selectedChatItemTTL, progressIndicator, appFilesCountAndSize) },
     onDismiss = { selectedChatItemTTL.value = m.chatItemTTL.value },
     destructive = true,
   )
@@ -592,6 +594,7 @@ private fun deleteChat(m: ChatModel, progressIndicator: MutableState<Boolean>) {
 
 private fun setCiTTL(
   m: ChatModel,
+  rhId: Long?,
   chatItemTTL: MutableState<ChatItemTTL>,
   progressIndicator: MutableState<Boolean>,
   appFilesCountAndSize: MutableState<Pair<Int, Long>>,
@@ -600,7 +603,7 @@ private fun setCiTTL(
   progressIndicator.value = true
   withApi {
     try {
-      m.controller.setChatItemTTL(chatItemTTL.value)
+      m.controller.setChatItemTTL(rhId, chatItemTTL.value)
       // Update model on success
       m.chatItemTTL.value = chatItemTTL.value
       afterSetCiTTL(m, progressIndicator, appFilesCountAndSize)
@@ -623,7 +626,8 @@ private fun afterSetCiTTL(
   withApi {
     try {
       updatingChatsMutex.withLock {
-        val chats = m.controller.apiGetChats()
+        // this is using current remote host on purpose - if it changes during update, it will load correct chats
+        val chats = m.controller.apiGetChats(m.remoteHostId)
         m.updateChats(chats)
       }
     } catch (e: Exception) {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt
index 4ed5ea56b..dbadec32f 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/Utils.kt
@@ -373,7 +373,7 @@ inline fun <reified T> serializableSaver(): Saver<T, *> = Saver(
 fun UriHandler.openVerifiedSimplexUri(uri: String) {
   val URI = try { URI.create(uri) } catch (e: Exception) { null }
   if (URI != null) {
-    connectIfOpenedViaUri(URI, ChatModel)
+    connectIfOpenedViaUri(chatModel.remoteHostId, URI, ChatModel)
   }
 }
 
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/localauth/LocalAuthView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/localauth/LocalAuthView.kt
index 8b5c2a833..c64c3dd29 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/localauth/LocalAuthView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/localauth/LocalAuthView.kt
@@ -63,7 +63,7 @@ private fun deleteStorageAndRestart(m: ChatModel, password: String, completed: (
       if (!displayName.isNullOrEmpty()) {
         profile = Profile(displayName = displayName, fullName = "")
       }
-      val createdUser = m.controller.apiCreateActiveUser(profile, pastTimestamp = true)
+      val createdUser = m.controller.apiCreateActiveUser(null, profile, pastTimestamp = true)
       m.currentUser.value = createdUser
       m.controller.appPrefs.onboardingStage.set(OnboardingStage.OnboardingComplete)
       if (createdUser != null) {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/AddContactView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/AddContactView.kt
index ef3633d1f..360667fcf 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/AddContactView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/AddContactView.kt
@@ -25,11 +25,13 @@ import chat.simplex.res.MR
 @Composable
 fun AddContactView(
   chatModel: ChatModel,
+  rhId: Long?,
   connReqInvitation: String,
   contactConnection: MutableState<PendingContactConnection?>
 ) {
   val clipboard = LocalClipboardManager.current
   AddContactLayout(
+    rhId = rhId,
     chatModel = chatModel,
     incognitoPref = chatModel.controller.appPrefs.incognito,
     connReq = connReqInvitation,
@@ -52,6 +54,7 @@ fun AddContactView(
 @Composable
 fun AddContactLayout(
   chatModel: ChatModel,
+  rhId: Long?,
   incognitoPref: SharedPreference<Boolean>,
   connReq: String,
   contactConnection: MutableState<PendingContactConnection?>,
@@ -63,9 +66,9 @@ fun AddContactLayout(
     withApi {
       val contactConnVal = contactConnection.value
       if (contactConnVal != null) {
-        chatModel.controller.apiSetConnectionIncognito(contactConnVal.pccConnId, incognito.value)?.let {
+        chatModel.controller.apiSetConnectionIncognito(rhId, contactConnVal.pccConnId, incognito.value)?.let {
           contactConnection.value = it
-          chatModel.updateContactConnection(it)
+          chatModel.updateContactConnection(rhId, it)
         }
       }
     }
@@ -172,6 +175,7 @@ fun sharedProfileInfo(
 fun PreviewAddContactView() {
   SimpleXTheme {
     AddContactLayout(
+      rhId = null,
       chatModel = ChatModel,
       incognitoPref = SharedPreference({ false }, {}),
       connReq = "https://simplex.chat/contact#/?v=1&smp=smp%3A%2F%2FPQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo%3D%40smp6.simplex.im%2FK1rslx-m5bpXVIdMZg9NLUZ_8JBm8xTt%23MCowBQYDK2VuAyEALDeVe-sG8mRY22LsXlPgiwTNs9dbiLrNuA7f3ZMAJ2w%3D",
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/AddGroupView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/AddGroupView.kt
index 9b2cedefa..d60ee7531 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/AddGroupView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/AddGroupView.kt
@@ -32,25 +32,25 @@ import kotlinx.coroutines.launch
 import java.net.URI
 
 @Composable
-fun AddGroupView(chatModel: ChatModel, close: () -> Unit) {
+fun AddGroupView(chatModel: ChatModel, rhId: Long?, close: () -> Unit) {
   AddGroupLayout(
     createGroup = { incognito, groupProfile ->
       withApi {
-        val groupInfo = chatModel.controller.apiNewGroup(incognito, groupProfile)
+        val groupInfo = chatModel.controller.apiNewGroup(rhId, incognito, groupProfile)
         if (groupInfo != null) {
-          chatModel.addChat(Chat(chatInfo = ChatInfo.Group(groupInfo), chatItems = listOf()))
+          chatModel.addChat(Chat(remoteHostId = rhId, chatInfo = ChatInfo.Group(groupInfo), chatItems = listOf()))
           chatModel.chatItems.clear()
           chatModel.chatItemStatuses.clear()
           chatModel.chatId.value = groupInfo.id
-          setGroupMembers(groupInfo, chatModel)
+          setGroupMembers(rhId, groupInfo, chatModel)
           close.invoke()
           if (!groupInfo.incognito) {
             ModalManager.end.showModalCloseable(true) { close ->
-              AddGroupMembersView(groupInfo, creatingGroup = true, chatModel, close)
+              AddGroupMembersView(rhId, groupInfo, creatingGroup = true, chatModel, close)
             }
           } else {
             ModalManager.end.showModalCloseable(true) { close ->
-              GroupLinkView(chatModel, groupInfo, connReqContact = null, memberRole = null, onGroupLinkUpdated = null, creatingGroup = true, close)
+              GroupLinkView(chatModel, rhId, groupInfo, connReqContact = null, memberRole = null, onGroupLinkUpdated = null, creatingGroup = true, close)
             }
           }
         }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.kt
index a2bc2c4df..e41c8701e 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.kt
@@ -8,4 +8,4 @@ enum class ConnectViaLinkTab {
 }
 
 @Composable
-expect fun ConnectViaLinkView(m: ChatModel, close: () -> Unit)
+expect fun ConnectViaLinkView(m: ChatModel, rhId: Long?, close: () -> Unit)
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ContactConnectionInfoView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ContactConnectionInfoView.kt
index d04a85d90..50419cdaf 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ContactConnectionInfoView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ContactConnectionInfoView.kt
@@ -30,6 +30,7 @@ import chat.simplex.res.MR
 @Composable
 fun ContactConnectionInfoView(
   chatModel: ChatModel,
+  rhId: Long?,
   connReqInvitation: String?,
   contactConnection: PendingContactConnection,
   focusAlias: Boolean,
@@ -55,8 +56,8 @@ fun ContactConnectionInfoView(
     connReq = connReqInvitation,
     contactConnection = contactConnection,
     focusAlias = focusAlias,
-    deleteConnection = { deleteContactConnectionAlert(contactConnection, chatModel, close) },
-    onLocalAliasChanged = { setContactAlias(contactConnection, it, chatModel) },
+    deleteConnection = { deleteContactConnectionAlert(rhId, contactConnection, chatModel, close) },
+    onLocalAliasChanged = { setContactAlias(rhId, contactConnection, it, chatModel) },
     share = { if (connReqInvitation != null) clipboard.shareText(connReqInvitation) },
     learnMore = {
       ModalManager.center.showModal {
@@ -165,9 +166,9 @@ fun DeleteButton(onClick: () -> Unit) {
   )
 }
 
-private fun setContactAlias(contactConnection: PendingContactConnection, localAlias: String, chatModel: ChatModel) = withApi {
-  chatModel.controller.apiSetConnectionAlias(contactConnection.pccConnId, localAlias)?.let {
-    chatModel.updateContactConnection(it)
+private fun setContactAlias(rhId: Long?, contactConnection: PendingContactConnection, localAlias: String, chatModel: ChatModel) = withApi {
+  chatModel.controller.apiSetConnectionAlias(rhId, contactConnection.pccConnId, localAlias)?.let {
+    chatModel.updateContactConnection(rhId, it)
   }
 }
 
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/CreateLinkView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/CreateLinkView.kt
index 94538655b..f4252f53b 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/CreateLinkView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/CreateLinkView.kt
@@ -20,7 +20,7 @@ enum class CreateLinkTab {
 }
 
 @Composable
-fun CreateLinkView(m: ChatModel, initialSelection: CreateLinkTab) {
+fun CreateLinkView(m: ChatModel, rhId: Long?, initialSelection: CreateLinkTab) {
   val selection = remember { mutableStateOf(initialSelection) }
   val connReqInvitation = rememberSaveable { m.connReqInv }
   val contactConnection: MutableState<PendingContactConnection?> = rememberSaveable(stateSaver = serializableSaver()) { mutableStateOf(null) }
@@ -32,7 +32,7 @@ fun CreateLinkView(m: ChatModel, initialSelection: CreateLinkTab) {
       && contactConnection.value == null
       && !creatingConnReq.value
     ) {
-      createInvitation(m, creatingConnReq, connReqInvitation, contactConnection)
+      createInvitation(m, rhId, creatingConnReq, connReqInvitation, contactConnection)
     }
   }
   /** When [AddContactView] is open, we don't need to drop [chatModel.connReqInv].
@@ -65,10 +65,10 @@ fun CreateLinkView(m: ChatModel, initialSelection: CreateLinkTab) {
     Column(Modifier.weight(1f)) {
       when (selection.value) {
         CreateLinkTab.ONE_TIME -> {
-          AddContactView(m, connReqInvitation.value ?: "", contactConnection)
+          AddContactView(m, rhId,connReqInvitation.value ?: "", contactConnection)
         }
         CreateLinkTab.LONG_TERM -> {
-          UserAddressView(m, viaCreateLinkView = true, close = {})
+          UserAddressView(m, rhId, viaCreateLinkView = true, close = {})
         }
       }
     }
@@ -100,13 +100,14 @@ fun CreateLinkView(m: ChatModel, initialSelection: CreateLinkTab) {
 
 private fun createInvitation(
   m: ChatModel,
+  rhId: Long?,
   creatingConnReq: MutableState<Boolean>,
   connReqInvitation: MutableState<String?>,
   contactConnection: MutableState<PendingContactConnection?>
 ) {
   creatingConnReq.value = true
   withApi {
-    val r = m.controller.apiAddContact(incognito = m.controller.appPrefs.incognito.get())
+    val r = m.controller.apiAddContact(rhId, incognito = m.controller.appPrefs.incognito.get())
     if (r != null) {
       connReqInvitation.value = r.first
       contactConnection.value = r.second
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/NewChatSheet.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/NewChatSheet.kt
index 8ec54e344..382bc72e4 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/NewChatSheet.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/NewChatSheet.kt
@@ -33,7 +33,8 @@ import kotlinx.coroutines.launch
 import kotlin.math.roundToInt
 
 @Composable
-fun NewChatSheet(chatModel: ChatModel, newChatSheetState: StateFlow<AnimatedViewState>, stopped: Boolean, closeNewChatSheet: (animated: Boolean) -> Unit) {
+fun NewChatSheet(chatModel: ChatModel, rhId: Long?, newChatSheetState: StateFlow<AnimatedViewState>, stopped: Boolean, closeNewChatSheet: (animated: Boolean) -> Unit) {
+  // TODO close new chat if remote host changes in model
   if (newChatSheetState.collectAsState().value.isVisible()) BackHandler { closeNewChatSheet(true) }
   NewChatSheetLayout(
     newChatSheetState,
@@ -41,17 +42,17 @@ fun NewChatSheet(chatModel: ChatModel, newChatSheetState: StateFlow<AnimatedView
     addContact = {
       closeNewChatSheet(false)
       ModalManager.center.closeModals()
-      ModalManager.center.showModal { CreateLinkView(chatModel, CreateLinkTab.ONE_TIME) }
+      ModalManager.center.showModal { CreateLinkView(chatModel, rhId, CreateLinkTab.ONE_TIME) }
     },
     connectViaLink = {
       closeNewChatSheet(false)
       ModalManager.center.closeModals()
-      ModalManager.center.showModalCloseable { close -> ConnectViaLinkView(chatModel, close) }
+      ModalManager.center.showModalCloseable { close -> ConnectViaLinkView(chatModel, rhId, close) }
     },
     createGroup = {
       closeNewChatSheet(false)
       ModalManager.center.closeModals()
-      ModalManager.center.showCustomModal { close -> AddGroupView(chatModel, close) }
+      ModalManager.center.showCustomModal { close -> AddGroupView(chatModel, rhId, close) }
     },
     closeNewChatSheet,
   )
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/PasteToConnect.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/PasteToConnect.kt
index b142b8e16..d40fa9762 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/PasteToConnect.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/PasteToConnect.kt
@@ -24,11 +24,12 @@ import chat.simplex.res.MR
 import java.net.URI
 
 @Composable
-fun PasteToConnectView(chatModel: ChatModel, close: () -> Unit) {
+fun PasteToConnectView(chatModel: ChatModel, rhId: Long?, close: () -> Unit) {
   val connectionLink = remember { mutableStateOf("") }
   val clipboard = LocalClipboardManager.current
   PasteToConnectLayout(
     chatModel = chatModel,
+    rhId = rhId,
     incognitoPref = chatModel.controller.appPrefs.incognito,
     connectionLink = connectionLink,
     pasteFromClipboard = {
@@ -41,6 +42,7 @@ fun PasteToConnectView(chatModel: ChatModel, close: () -> Unit) {
 @Composable
 fun PasteToConnectLayout(
   chatModel: ChatModel,
+  rhId: Long?,
   incognitoPref: SharedPreference<Boolean>,
   connectionLink: MutableState<String>,
   pasteFromClipboard: () -> Unit,
@@ -52,7 +54,7 @@ fun PasteToConnectLayout(
     try {
       val uri = URI(connReqUri)
       withApi {
-        planAndConnect(chatModel, uri, incognito = incognito.value, close)
+        planAndConnect(chatModel, rhId, uri, incognito = incognito.value, close)
       }
     } catch (e: RuntimeException) {
       AlertManager.shared.showAlertMsg(
@@ -124,6 +126,7 @@ fun PreviewPasteToConnectTextbox() {
   SimpleXTheme {
     PasteToConnectLayout(
       chatModel = ChatModel,
+      rhId = null,
       incognitoPref = SharedPreference({ false }, {}),
       connectionLink = remember { mutableStateOf("") },
       pasteFromClipboard = {},
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.kt
index 7629256fc..523b7e532 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.kt
@@ -26,7 +26,7 @@ import chat.simplex.res.MR
 import java.net.URI
 
 @Composable
-expect fun ScanToConnectView(chatModel: ChatModel, close: () -> Unit)
+expect fun ScanToConnectView(chatModel: ChatModel, rhId: Long?, close: () -> Unit)
 
 enum class ConnectionLinkType {
   INVITATION, CONTACT, GROUP
@@ -34,21 +34,22 @@ enum class ConnectionLinkType {
 
 suspend fun planAndConnect(
   chatModel: ChatModel,
+  rhId: Long?,
   uri: URI,
   incognito: Boolean?,
   close: (() -> Unit)?
 ) {
-  val connectionPlan = chatModel.controller.apiConnectPlan(uri.toString())
+  val connectionPlan = chatModel.controller.apiConnectPlan(rhId, uri.toString())
   if (connectionPlan != null) {
     when (connectionPlan) {
       is ConnectionPlan.InvitationLink -> when (connectionPlan.invitationLinkPlan) {
         InvitationLinkPlan.Ok -> {
           Log.d(TAG, "planAndConnect, .InvitationLink, .Ok, incognito=$incognito")
           if (incognito != null) {
-            connectViaUri(chatModel, uri, incognito, connectionPlan, close)
+            connectViaUri(chatModel, rhId, uri, incognito, connectionPlan, close)
           } else {
             askCurrentOrIncognitoProfileAlert(
-              chatModel, uri, connectionPlan, close,
+              chatModel, rhId, uri, connectionPlan, close,
               title = generalGetString(MR.strings.connect_via_invitation_link),
               text = AnnotatedString(generalGetString(MR.strings.profile_will_be_sent_to_contact_sending_link)),
               connectDestructive = false
@@ -62,12 +63,12 @@ suspend fun planAndConnect(
               title = generalGetString(MR.strings.connect_plan_connect_to_yourself),
               text = generalGetString(MR.strings.connect_plan_this_is_your_own_one_time_link),
               confirmText = if (incognito) generalGetString(MR.strings.connect_via_link_incognito) else generalGetString(MR.strings.connect_via_link_verb),
-              onConfirm = { withApi { connectViaUri(chatModel, uri, incognito, connectionPlan, close) } },
+              onConfirm = { withApi { connectViaUri(chatModel, rhId, uri, incognito, connectionPlan, close) } },
               destructive = true,
             )
           } else {
             askCurrentOrIncognitoProfileAlert(
-              chatModel, uri, connectionPlan, close,
+              chatModel, rhId, uri, connectionPlan, close,
               title = generalGetString(MR.strings.connect_plan_connect_to_yourself),
               text = AnnotatedString(generalGetString(MR.strings.connect_plan_this_is_your_own_one_time_link)),
               connectDestructive = true
@@ -78,7 +79,7 @@ suspend fun planAndConnect(
           Log.d(TAG, "planAndConnect, .InvitationLink, .Connecting, incognito=$incognito")
           val contact = connectionPlan.invitationLinkPlan.contact_
           if (contact != null) {
-            openKnownContact(chatModel, close, contact)
+            openKnownContact(chatModel, rhId, close, contact)
             AlertManager.shared.showAlertMsg(
               generalGetString(MR.strings.contact_already_exists),
               String.format(generalGetString(MR.strings.connect_plan_you_are_already_connecting_to_vName), contact.displayName)
@@ -93,7 +94,7 @@ suspend fun planAndConnect(
         is InvitationLinkPlan.Known -> {
           Log.d(TAG, "planAndConnect, .InvitationLink, .Known, incognito=$incognito")
           val contact = connectionPlan.invitationLinkPlan.contact
-          openKnownContact(chatModel, close, contact)
+          openKnownContact(chatModel, rhId, close, contact)
           AlertManager.shared.showAlertMsg(
             generalGetString(MR.strings.contact_already_exists),
             String.format(generalGetString(MR.strings.you_are_already_connected_to_vName_via_this_link), contact.displayName)
@@ -104,10 +105,10 @@ suspend fun planAndConnect(
         ContactAddressPlan.Ok -> {
           Log.d(TAG, "planAndConnect, .ContactAddress, .Ok, incognito=$incognito")
           if (incognito != null) {
-            connectViaUri(chatModel, uri, incognito, connectionPlan, close)
+            connectViaUri(chatModel, rhId, uri, incognito, connectionPlan, close)
           } else {
             askCurrentOrIncognitoProfileAlert(
-              chatModel, uri, connectionPlan, close,
+              chatModel, rhId, uri, connectionPlan, close,
               title = generalGetString(MR.strings.connect_via_contact_link),
               text = AnnotatedString(generalGetString(MR.strings.profile_will_be_sent_to_contact_sending_link)),
               connectDestructive = false
@@ -121,12 +122,12 @@ suspend fun planAndConnect(
               title = generalGetString(MR.strings.connect_plan_connect_to_yourself),
               text = generalGetString(MR.strings.connect_plan_this_is_your_own_simplex_address),
               confirmText = if (incognito) generalGetString(MR.strings.connect_via_link_incognito) else generalGetString(MR.strings.connect_via_link_verb),
-              onConfirm = { withApi { connectViaUri(chatModel, uri, incognito, connectionPlan, close) } },
+              onConfirm = { withApi { connectViaUri(chatModel, rhId, uri, incognito, connectionPlan, close) } },
               destructive = true,
             )
           } else {
             askCurrentOrIncognitoProfileAlert(
-              chatModel, uri, connectionPlan, close,
+              chatModel, rhId, uri, connectionPlan, close,
               title = generalGetString(MR.strings.connect_plan_connect_to_yourself),
               text = AnnotatedString(generalGetString(MR.strings.connect_plan_this_is_your_own_simplex_address)),
               connectDestructive = true
@@ -140,12 +141,12 @@ suspend fun planAndConnect(
               title = generalGetString(MR.strings.connect_plan_repeat_connection_request),
               text = generalGetString(MR.strings.connect_plan_you_have_already_requested_connection_via_this_address),
               confirmText = if (incognito) generalGetString(MR.strings.connect_via_link_incognito) else generalGetString(MR.strings.connect_via_link_verb),
-              onConfirm = { withApi { connectViaUri(chatModel, uri, incognito, connectionPlan, close) } },
+              onConfirm = { withApi { connectViaUri(chatModel, rhId, uri, incognito, connectionPlan, close) } },
               destructive = true,
             )
           } else {
             askCurrentOrIncognitoProfileAlert(
-              chatModel, uri, connectionPlan, close,
+              chatModel, rhId, uri, connectionPlan, close,
               title = generalGetString(MR.strings.connect_plan_repeat_connection_request),
               text = AnnotatedString(generalGetString(MR.strings.connect_plan_you_have_already_requested_connection_via_this_address)),
               connectDestructive = true
@@ -155,7 +156,7 @@ suspend fun planAndConnect(
         is ContactAddressPlan.ConnectingProhibit -> {
           Log.d(TAG, "planAndConnect, .ContactAddress, .ConnectingProhibit, incognito=$incognito")
           val contact = connectionPlan.contactAddressPlan.contact
-          openKnownContact(chatModel, close, contact)
+          openKnownContact(chatModel, rhId, close, contact)
           AlertManager.shared.showAlertMsg(
             generalGetString(MR.strings.contact_already_exists),
             String.format(generalGetString(MR.strings.connect_plan_you_are_already_connecting_to_vName), contact.displayName)
@@ -164,7 +165,7 @@ suspend fun planAndConnect(
         is ContactAddressPlan.Known -> {
           Log.d(TAG, "planAndConnect, .ContactAddress, .Known, incognito=$incognito")
           val contact = connectionPlan.contactAddressPlan.contact
-          openKnownContact(chatModel, close, contact)
+          openKnownContact(chatModel, rhId, close, contact)
           AlertManager.shared.showAlertMsg(
             generalGetString(MR.strings.contact_already_exists),
             String.format(generalGetString(MR.strings.you_are_already_connected_to_vName_via_this_link), contact.displayName)
@@ -175,9 +176,9 @@ suspend fun planAndConnect(
           val contact = connectionPlan.contactAddressPlan.contact
           if (incognito != null) {
             close?.invoke()
-            connectContactViaAddress(chatModel, contact.contactId, incognito)
+            connectContactViaAddress(chatModel, rhId, contact.contactId, incognito)
           } else {
-            askCurrentOrIncognitoProfileConnectContactViaAddress(chatModel, contact, close, openChat = false)
+            askCurrentOrIncognitoProfileConnectContactViaAddress(chatModel, rhId, contact, close, openChat = false)
           }
         }
       }
@@ -189,11 +190,11 @@ suspend fun planAndConnect(
               title = generalGetString(MR.strings.connect_via_group_link),
               text = generalGetString(MR.strings.you_will_join_group),
               confirmText = if (incognito) generalGetString(MR.strings.join_group_incognito_button) else generalGetString(MR.strings.join_group_button),
-              onConfirm = { withApi { connectViaUri(chatModel, uri, incognito, connectionPlan, close) } }
+              onConfirm = { withApi { connectViaUri(chatModel, rhId, uri, incognito, connectionPlan, close) } }
             )
           } else {
             askCurrentOrIncognitoProfileAlert(
-              chatModel, uri, connectionPlan, close,
+              chatModel, rhId, uri, connectionPlan, close,
               title = generalGetString(MR.strings.connect_via_group_link),
               text = AnnotatedString(generalGetString(MR.strings.you_will_join_group)),
               connectDestructive = false
@@ -203,7 +204,7 @@ suspend fun planAndConnect(
         is GroupLinkPlan.OwnLink -> {
           Log.d(TAG, "planAndConnect, .GroupLink, .OwnLink, incognito=$incognito")
           val groupInfo = connectionPlan.groupLinkPlan.groupInfo
-          ownGroupLinkConfirmConnect(chatModel, uri, incognito, connectionPlan, groupInfo, close)
+          ownGroupLinkConfirmConnect(chatModel, rhId, uri, incognito, connectionPlan, groupInfo, close)
         }
         GroupLinkPlan.ConnectingConfirmReconnect -> {
           Log.d(TAG, "planAndConnect, .GroupLink, .ConnectingConfirmReconnect, incognito=$incognito")
@@ -212,12 +213,12 @@ suspend fun planAndConnect(
               title = generalGetString(MR.strings.connect_plan_repeat_join_request),
               text = generalGetString(MR.strings.connect_plan_you_are_already_joining_the_group_via_this_link),
               confirmText = if (incognito) generalGetString(MR.strings.join_group_incognito_button) else generalGetString(MR.strings.join_group_button),
-              onConfirm = { withApi { connectViaUri(chatModel, uri, incognito, connectionPlan, close) } },
+              onConfirm = { withApi { connectViaUri(chatModel, rhId, uri, incognito, connectionPlan, close) } },
               destructive = true,
             )
           } else {
             askCurrentOrIncognitoProfileAlert(
-              chatModel, uri, connectionPlan, close,
+              chatModel, rhId, uri, connectionPlan, close,
               title = generalGetString(MR.strings.connect_plan_repeat_join_request),
               text = AnnotatedString(generalGetString(MR.strings.connect_plan_you_are_already_joining_the_group_via_this_link)),
               connectDestructive = true
@@ -242,7 +243,7 @@ suspend fun planAndConnect(
         is GroupLinkPlan.Known -> {
           Log.d(TAG, "planAndConnect, .GroupLink, .Known, incognito=$incognito")
           val groupInfo = connectionPlan.groupLinkPlan.groupInfo
-          openKnownGroup(chatModel, close, groupInfo)
+          openKnownGroup(chatModel, rhId, close, groupInfo)
           AlertManager.shared.showAlertMsg(
             generalGetString(MR.strings.connect_plan_group_already_exists),
             String.format(generalGetString(MR.strings.connect_plan_you_are_already_in_group_vName), groupInfo.displayName)
@@ -253,10 +254,10 @@ suspend fun planAndConnect(
   } else {
     Log.d(TAG, "planAndConnect, plan error")
     if (incognito != null) {
-      connectViaUri(chatModel, uri, incognito, connectionPlan = null, close)
+      connectViaUri(chatModel, rhId, uri, incognito, connectionPlan = null, close)
     } else {
       askCurrentOrIncognitoProfileAlert(
-        chatModel, uri, connectionPlan = null, close,
+        chatModel, rhId, uri, connectionPlan = null, close,
         title = generalGetString(MR.strings.connect_plan_connect_via_link),
         connectDestructive = false
       )
@@ -266,12 +267,13 @@ suspend fun planAndConnect(
 
 suspend fun connectViaUri(
   chatModel: ChatModel,
+  rhId: Long?,
   uri: URI,
   incognito: Boolean,
   connectionPlan: ConnectionPlan?,
   close: (() -> Unit)?
 ): Boolean {
-  val r = chatModel.controller.apiConnect(incognito, uri.toString())
+  val r = chatModel.controller.apiConnect(rhId, incognito, uri.toString())
   val connLinkType = if (connectionPlan != null) planToConnectionLinkType(connectionPlan) else ConnectionLinkType.INVITATION
   if (r) {
     close?.invoke()
@@ -298,6 +300,7 @@ fun planToConnectionLinkType(connectionPlan: ConnectionPlan): ConnectionLinkType
 
 fun askCurrentOrIncognitoProfileAlert(
   chatModel: ChatModel,
+  rhId: Long?,
   uri: URI,
   connectionPlan: ConnectionPlan?,
   close: (() -> Unit)?,
@@ -314,7 +317,7 @@ fun askCurrentOrIncognitoProfileAlert(
         SectionItemView({
           AlertManager.shared.hideAlert()
           withApi {
-            connectViaUri(chatModel, uri, incognito = false, connectionPlan, close)
+            connectViaUri(chatModel, rhId, uri, incognito = false, connectionPlan, close)
           }
         }) {
           Text(generalGetString(MR.strings.connect_use_current_profile), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = connectColor)
@@ -322,7 +325,7 @@ fun askCurrentOrIncognitoProfileAlert(
         SectionItemView({
           AlertManager.shared.hideAlert()
           withApi {
-            connectViaUri(chatModel, uri, incognito = true, connectionPlan, close)
+            connectViaUri(chatModel, rhId, uri, incognito = true, connectionPlan, close)
           }
         }) {
           Text(generalGetString(MR.strings.connect_use_new_incognito_profile), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = connectColor)
@@ -337,18 +340,19 @@ fun askCurrentOrIncognitoProfileAlert(
   )
 }
 
-fun openKnownContact(chatModel: ChatModel, close: (() -> Unit)?, contact: Contact) {
+fun openKnownContact(chatModel: ChatModel, rhId: Long?, close: (() -> Unit)?, contact: Contact) {
   withApi {
     val c = chatModel.getContactChat(contact.contactId)
     if (c != null) {
       close?.invoke()
-      openDirectChat(contact.contactId, chatModel)
+      openDirectChat(rhId, contact.contactId, chatModel)
     }
   }
 }
 
 fun ownGroupLinkConfirmConnect(
   chatModel: ChatModel,
+  rhId: Long?,
   uri: URI,
   incognito: Boolean?,
   connectionPlan: ConnectionPlan?,
@@ -363,7 +367,7 @@ fun ownGroupLinkConfirmConnect(
         // Open group
         SectionItemView({
           AlertManager.shared.hideAlert()
-          openKnownGroup(chatModel, close, groupInfo)
+          openKnownGroup(chatModel, rhId, close, groupInfo)
         }) {
           Text(generalGetString(MR.strings.connect_plan_open_group), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = MaterialTheme.colors.primary)
         }
@@ -372,7 +376,7 @@ fun ownGroupLinkConfirmConnect(
           SectionItemView({
             AlertManager.shared.hideAlert()
             withApi {
-              connectViaUri(chatModel, uri, incognito, connectionPlan, close)
+              connectViaUri(chatModel, rhId, uri, incognito, connectionPlan, close)
             }
           }) {
             Text(
@@ -385,7 +389,7 @@ fun ownGroupLinkConfirmConnect(
           SectionItemView({
             AlertManager.shared.hideAlert()
             withApi {
-              connectViaUri(chatModel, uri, incognito = false, connectionPlan, close)
+              connectViaUri(chatModel, rhId, uri, incognito = false, connectionPlan, close)
             }
           }) {
             Text(generalGetString(MR.strings.connect_use_current_profile), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = MaterialTheme.colors.error)
@@ -394,7 +398,7 @@ fun ownGroupLinkConfirmConnect(
           SectionItemView({
             AlertManager.shared.hideAlert()
             withApi {
-              connectViaUri(chatModel, uri, incognito = true, connectionPlan, close)
+              connectViaUri(chatModel, rhId, uri, incognito = true, connectionPlan, close)
             }
           }) {
             Text(generalGetString(MR.strings.connect_use_new_incognito_profile), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = MaterialTheme.colors.error)
@@ -411,12 +415,12 @@ fun ownGroupLinkConfirmConnect(
   )
 }
 
-fun openKnownGroup(chatModel: ChatModel, close: (() -> Unit)?, groupInfo: GroupInfo) {
+fun openKnownGroup(chatModel: ChatModel, rhId: Long?, close: (() -> Unit)?, groupInfo: GroupInfo) {
   withApi {
     val g = chatModel.getGroupChat(groupInfo.groupId)
     if (g != null) {
       close?.invoke()
-      openGroupChat(groupInfo.groupId, chatModel)
+      openGroupChat(rhId, groupInfo.groupId, chatModel)
     }
   }
 }
@@ -424,6 +428,7 @@ fun openKnownGroup(chatModel: ChatModel, close: (() -> Unit)?, groupInfo: GroupI
 @Composable
 fun ConnectContactLayout(
   chatModel: ChatModel,
+  rhId: Long?,
   incognitoPref: SharedPreference<Boolean>,
   close: () -> Unit
 ) {
@@ -435,7 +440,7 @@ fun ConnectContactLayout(
       try {
         val uri = URI(connReqUri)
         withApi {
-          planAndConnect(chatModel, uri, incognito = incognito.value, close)
+          planAndConnect(chatModel, rhId, uri, incognito = incognito.value, close)
         }
       } catch (e: RuntimeException) {
         AlertManager.shared.showAlertMsg(
@@ -487,6 +492,7 @@ fun PreviewConnectContactLayout() {
   SimpleXTheme {
     ConnectContactLayout(
       chatModel = ChatModel,
+      rhId = null,
       incognitoPref = SharedPreference({ false }, {}),
       close = {},
     )
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/CreateSimpleXAddress.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/CreateSimpleXAddress.kt
index 013222338..49e62fb06 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/CreateSimpleXAddress.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/CreateSimpleXAddress.kt
@@ -23,14 +23,14 @@ import chat.simplex.common.views.newchat.simplexChatLink
 import chat.simplex.res.MR
 
 @Composable
-fun CreateSimpleXAddress(m: ChatModel) {
+fun CreateSimpleXAddress(m: ChatModel, rhId: Long?) {
   var progressIndicator by remember { mutableStateOf(false) }
   val userAddress = remember { m.userAddress }
   val clipboard = LocalClipboardManager.current
   val uriHandler = LocalUriHandler.current
 
   LaunchedEffect(Unit) {
-    prepareChatBeforeAddressCreation()
+    prepareChatBeforeAddressCreation(rhId)
   }
 
   CreateSimpleXAddressLayout(
@@ -45,11 +45,11 @@ fun CreateSimpleXAddress(m: ChatModel) {
     createAddress = {
       withApi {
         progressIndicator = true
-        val connReqContact = m.controller.apiCreateUserAddress()
+        val connReqContact = m.controller.apiCreateUserAddress(rhId)
         if (connReqContact != null) {
           m.userAddress.value = UserContactLinkRec(connReqContact)
           try {
-            val u = m.controller.apiSetProfileAddress(true)
+            val u = m.controller.apiSetProfileAddress(rhId, true)
             if (u != null) {
               m.updateUser(u)
             }
@@ -176,18 +176,18 @@ private fun ProgressIndicator() {
   }
 }
 
-private fun prepareChatBeforeAddressCreation() {
+private fun prepareChatBeforeAddressCreation(rhId: Long?) {
   if (chatModel.users.isNotEmpty()) return
   withApi {
-    val user = chatModel.controller.apiGetActiveUser() ?: return@withApi
+    val user = chatModel.controller.apiGetActiveUser(rhId) ?: return@withApi
     chatModel.currentUser.value = user
     if (chatModel.users.isEmpty()) {
       chatModel.controller.startChat(user)
     } else {
-      val users = chatModel.controller.listUsers()
+      val users = chatModel.controller.listUsers(rhId)
       chatModel.users.clear()
       chatModel.users.addAll(users)
-      chatModel.controller.getUserChatData()
+      chatModel.controller.getUserChatData(rhId)
     }
   }
 }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/SetupDatabasePassphrase.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/SetupDatabasePassphrase.kt
index 9bc5ae846..a4ebd23de 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/SetupDatabasePassphrase.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/SetupDatabasePassphrase.kt
@@ -80,7 +80,7 @@ fun SetupDatabasePassphrase(m: ChatModel) {
     onDispose {
       if (m.chatRunning.value != true) {
         withBGApi {
-          val user = chatController.apiGetActiveUser()
+          val user = chatController.apiGetActiveUser(null)
           if (user != null) {
             m.controller.startChat(user)
           }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/HiddenProfileView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/HiddenProfileView.kt
index 215899d0f..f3496c850 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/HiddenProfileView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/HiddenProfileView.kt
@@ -34,7 +34,7 @@ fun HiddenProfileView(
     saveProfilePassword = { hidePassword ->
       withBGApi {
         try {
-          val u = m.controller.apiHideUser(user.userId, hidePassword)
+          val u = m.controller.apiHideUser(user, hidePassword)
           m.updateUser(u)
           close()
         } catch (e: Exception) {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/NetworkAndServers.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/NetworkAndServers.kt
index f2fee926a..9ee1b3938 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/NetworkAndServers.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/NetworkAndServers.kt
@@ -168,9 +168,9 @@ fun NetworkAndServersView(
   ) {
     AppBarTitle(stringResource(MR.strings.network_and_servers))
     SectionView(generalGetString(MR.strings.settings_section_title_messages)) {
-      SettingsActionItem(painterResource(MR.images.ic_dns), stringResource(MR.strings.smp_servers), showCustomModal { m, close -> ProtocolServersView(m, ServerProtocol.SMP, close) })
+      SettingsActionItem(painterResource(MR.images.ic_dns), stringResource(MR.strings.smp_servers), showCustomModal { m, close -> ProtocolServersView(m, m.remoteHostId, ServerProtocol.SMP, close) })
 
-      SettingsActionItem(painterResource(MR.images.ic_dns), stringResource(MR.strings.xftp_servers), showCustomModal { m, close -> ProtocolServersView(m, ServerProtocol.XFTP, close) })
+      SettingsActionItem(painterResource(MR.images.ic_dns), stringResource(MR.strings.xftp_servers), showCustomModal { m, close -> ProtocolServersView(m, m.remoteHostId, ServerProtocol.XFTP, close) })
 
       UseSocksProxySwitch(networkUseSocksProxy, proxyPort, toggleSocksProxy, showSettingsModal)
       UseOnionHosts(onionHosts, networkUseSocksProxy, showSettingsModal, useOnion)
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/Preferences.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/Preferences.kt
index 202602b28..e94c53f64 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/Preferences.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/Preferences.kt
@@ -25,11 +25,11 @@ fun PreferencesView(m: ChatModel, user: User, close: () -> Unit,) {
   fun savePrefs(afterSave: () -> Unit = {}) {
     withApi {
       val newProfile = user.profile.toProfile().copy(preferences = preferences.toPreferences())
-      val updated = m.controller.apiUpdateProfile(newProfile)
+      val updated = m.controller.apiUpdateProfile(user.remoteHostId, newProfile)
       if (updated != null) {
         val (updatedProfile, updatedContacts) = updated
-        m.updateCurrentUser(updatedProfile, preferences)
-        updatedContacts.forEach(m::updateContact)
+        m.updateCurrentUser(user.remoteHostId, updatedProfile, preferences)
+        updatedContacts.forEach { m.updateContact(user.remoteHostId, it) }
         currentPreferences = preferences
       }
       afterSave()
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/PrivacySettings.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/PrivacySettings.kt
index 84ab87c65..1a5aa49eb 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/PrivacySettings.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/PrivacySettings.kt
@@ -99,7 +99,7 @@ fun PrivacySettingsView(
       fun setSendReceiptsContacts(enable: Boolean, clearOverrides: Boolean) {
         withApi {
           val mrs = UserMsgReceiptSettings(enable, clearOverrides)
-          chatModel.controller.apiSetUserContactReceipts(currentUser.userId, mrs)
+          chatModel.controller.apiSetUserContactReceipts(currentUser, mrs)
           chatModel.controller.appPrefs.privacyDeliveryReceiptsSet.set(true)
           chatModel.currentUser.value = currentUser.copy(sendRcptsContacts = enable)
           if (clearOverrides) {
@@ -111,7 +111,7 @@ fun PrivacySettingsView(
                 val sendRcpts = contact.chatSettings.sendRcpts
                 if (sendRcpts != null && sendRcpts != enable) {
                   contact = contact.copy(chatSettings = contact.chatSettings.copy(sendRcpts = null))
-                  chatModel.updateContact(contact)
+                  chatModel.updateContact(currentUser.remoteHostId, contact)
                 }
               }
             }
@@ -122,7 +122,7 @@ fun PrivacySettingsView(
       fun setSendReceiptsGroups(enable: Boolean, clearOverrides: Boolean) {
         withApi {
           val mrs = UserMsgReceiptSettings(enable, clearOverrides)
-          chatModel.controller.apiSetUserGroupReceipts(currentUser.userId, mrs)
+          chatModel.controller.apiSetUserGroupReceipts(currentUser, mrs)
           chatModel.controller.appPrefs.privacyDeliveryReceiptsSet.set(true)
           chatModel.currentUser.value = currentUser.copy(sendRcptsSmallGroups = enable)
           if (clearOverrides) {
@@ -134,7 +134,7 @@ fun PrivacySettingsView(
                 val sendRcpts = groupInfo.chatSettings.sendRcpts
                 if (sendRcpts != null && sendRcpts != enable) {
                   groupInfo = groupInfo.copy(chatSettings = groupInfo.chatSettings.copy(sendRcpts = null))
-                  chatModel.updateGroup(groupInfo)
+                  chatModel.updateGroup(currentUser.remoteHostId, groupInfo)
                 }
               }
             }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ProtocolServerView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ProtocolServerView.kt
index f3896a3de..4e8da36a7 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ProtocolServerView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ProtocolServerView.kt
@@ -197,7 +197,7 @@ fun ShowTestStatus(server: ServerCfg, modifier: Modifier = Modifier) =
 
 suspend fun testServerConnection(server: ServerCfg, m: ChatModel): Pair<ServerCfg, ProtocolTestFailure?> =
   try {
-    val r = m.controller.testProtoServer(server.server)
+    val r = m.controller.testProtoServer(server.remoteHostId, server.server)
     server.copy(tested = r == null) to r
   } catch (e: Exception) {
     Log.e(TAG, "testServerConnection ${e.stackTraceToString()}")
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ProtocolServersView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ProtocolServersView.kt
index 92246b72f..cbcb7344f 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ProtocolServersView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ProtocolServersView.kt
@@ -28,7 +28,8 @@ import chat.simplex.res.MR
 import kotlinx.coroutines.launch
 
 @Composable
-fun ProtocolServersView(m: ChatModel, serverProtocol: ServerProtocol, close: () -> Unit) {
+fun ProtocolServersView(m: ChatModel, rhId: Long?, serverProtocol: ServerProtocol, close: () -> Unit) {
+  // TODO close if remote host changes
   var presetServers by remember { mutableStateOf(emptyList<String>()) }
   var servers by remember {
     mutableStateOf(m.userSMPServersUnsaved.value ?: emptyList())
@@ -51,7 +52,7 @@ fun ProtocolServersView(m: ChatModel, serverProtocol: ServerProtocol, close: ()
   }
 
   LaunchedEffect(Unit) {
-    val res = m.controller.getUserProtoServers(serverProtocol)
+    val res = m.controller.getUserProtoServers(rhId, serverProtocol)
     if (res != null) {
       currServers.value = res.protoServers
       presetServers = res.presetServers
@@ -90,7 +91,7 @@ fun ProtocolServersView(m: ChatModel, serverProtocol: ServerProtocol, close: ()
   ModalView(
     close = {
       if (saveDisabled.value) close()
-      else showUnsavedChangesAlert({ saveServers(serverProtocol, currServers, servers, m, close) }, close)
+      else showUnsavedChangesAlert({ saveServers(rhId, serverProtocol, currServers, servers, m, close) }, close)
     },
   ) {
     ProtocolServersLayout(
@@ -118,7 +119,7 @@ fun ProtocolServersView(m: ChatModel, serverProtocol: ServerProtocol, close: ()
                 SectionItemView({
                   AlertManager.shared.hideAlert()
                   ModalManager.start.showModalCloseable { close ->
-                    ScanProtocolServer {
+                    ScanProtocolServer(rhId) {
                       close()
                       servers = servers + it
                       m.userSMPServersUnsaved.value = servers
@@ -133,7 +134,7 @@ fun ProtocolServersView(m: ChatModel, serverProtocol: ServerProtocol, close: ()
               if (!hasAllPresets) {
                 SectionItemView({
                   AlertManager.shared.hideAlert()
-                  servers = (servers + addAllPresets(presetServers, servers, m)).sortedByDescending { it.preset }
+                  servers = (servers + addAllPresets(rhId, presetServers, servers, m)).sortedByDescending { it.preset }
                 }) {
                   Text(stringResource(MR.strings.smp_servers_preset_add), Modifier.fillMaxWidth(), textAlign = TextAlign.Center, color = MaterialTheme.colors.primary)
                 }
@@ -155,7 +156,7 @@ fun ProtocolServersView(m: ChatModel, serverProtocol: ServerProtocol, close: ()
         m.userSMPServersUnsaved.value = null
       },
       saveSMPServers = {
-        saveServers(serverProtocol, currServers, servers, m)
+        saveServers(rhId, serverProtocol, currServers, servers, m)
       },
       showServer = ::showServer,
     )
@@ -289,11 +290,11 @@ private fun uniqueAddress(s: ServerCfg, address: ServerAddress, servers: List<Se
 private fun hasAllPresets(presetServers: List<String>, servers: List<ServerCfg>, m: ChatModel): Boolean =
   presetServers.all { hasPreset(it, servers) } ?: true
 
-private fun addAllPresets(presetServers: List<String>, servers: List<ServerCfg>, m: ChatModel): List<ServerCfg> {
+private fun addAllPresets(rhId: Long?, presetServers: List<String>, servers: List<ServerCfg>, m: ChatModel): List<ServerCfg> {
   val toAdd = ArrayList<ServerCfg>()
   for (srv in presetServers) {
     if (!hasPreset(srv, servers)) {
-      toAdd.add(ServerCfg(srv, preset = true, tested = null, enabled = true))
+      toAdd.add(ServerCfg(remoteHostId = rhId, srv, preset = true, tested = null, enabled = true))
     }
   }
   return toAdd
@@ -346,9 +347,9 @@ private suspend fun runServersTest(servers: List<ServerCfg>, m: ChatModel, onUpd
   return fs
 }
 
-private fun saveServers(protocol: ServerProtocol, currServers: MutableState<List<ServerCfg>>, servers: List<ServerCfg>, m: ChatModel, afterSave: () -> Unit = {}) {
+private fun saveServers(rhId: Long?, protocol: ServerProtocol, currServers: MutableState<List<ServerCfg>>, servers: List<ServerCfg>, m: ChatModel, afterSave: () -> Unit = {}) {
   withApi {
-    if (m.controller.setUserProtoServers(protocol, servers)) {
+    if (m.controller.setUserProtoServers(rhId, protocol, servers)) {
       currServers.value = servers
       m.userSMPServersUnsaved.value = null
     }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.kt
index 02582ec93..ac74bd04d 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.kt
@@ -13,10 +13,10 @@ import chat.simplex.common.views.newchat.QRCodeScanner
 import chat.simplex.res.MR
 
 @Composable
-expect fun ScanProtocolServer(onNext: (ServerCfg) -> Unit)
+expect fun ScanProtocolServer(rhId: Long?, onNext: (ServerCfg) -> Unit)
 
 @Composable
-fun ScanProtocolServerLayout(onNext: (ServerCfg) -> Unit) {
+fun ScanProtocolServerLayout(rhId: Long?, onNext: (ServerCfg) -> Unit) {
   Column(
     Modifier
       .fillMaxSize()
@@ -32,7 +32,7 @@ fun ScanProtocolServerLayout(onNext: (ServerCfg) -> Unit) {
       QRCodeScanner { text ->
         val res = parseServerAddress(text)
         if (res != null) {
-          onNext(ServerCfg(text, false, null, true))
+          onNext(ServerCfg(remoteHostId = rhId, text, false, null, true))
         } else {
           AlertManager.shared.showAlertMsg(
             title = generalGetString(MR.strings.smp_servers_invalid_address),
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SetDeliveryReceiptsView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SetDeliveryReceiptsView.kt
index 089ec7713..b75f52268 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SetDeliveryReceiptsView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SetDeliveryReceiptsView.kt
@@ -26,12 +26,12 @@ fun SetDeliveryReceiptsView(m: ChatModel) {
       if (currentUser != null) {
         withApi {
           try {
-            m.controller.apiSetAllContactReceipts(enable = true)
+            m.controller.apiSetAllContactReceipts(currentUser.remoteHostId, enable = true)
             m.currentUser.value = currentUser.copy(sendRcptsContacts = true)
             m.setDeliveryReceipts.value = false
             m.controller.appPrefs.privacyDeliveryReceiptsSet.set(true)
             try {
-              val users = m.controller.listUsers()
+              val users = m.controller.listUsers(currentUser.remoteHostId)
               m.users.clear()
               m.users.addAll(users)
             } catch (e: Exception) {
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt
index 2d4e5c86b..7bd060e8d 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/SettingsView.kt
@@ -155,7 +155,7 @@ fun SettingsLayout(
         }
         val profileHidden = rememberSaveable { mutableStateOf(false) }
         SettingsActionItem(painterResource(MR.images.ic_manage_accounts), stringResource(MR.strings.your_chat_profiles), { withAuth(generalGetString(MR.strings.auth_open_chat_profiles), generalGetString(MR.strings.auth_log_in_using_credential)) { showSettingsModalWithSearch { it, search -> UserProfilesView(it, search, profileHidden) } } }, disabled = stopped, extraPadding = true)
-        SettingsActionItem(painterResource(MR.images.ic_qr_code), stringResource(MR.strings.your_simplex_contact_address), showCustomModal { it, close -> UserAddressView(it, shareViaProfile = it.currentUser.value!!.addressShared, close = close) }, disabled = stopped, extraPadding = true)
+        SettingsActionItem(painterResource(MR.images.ic_qr_code), stringResource(MR.strings.your_simplex_contact_address), showCustomModal { it, close -> UserAddressView(it, it.currentUser.value?.remoteHostId, shareViaProfile = it.currentUser.value!!.addressShared, close = close) }, disabled = stopped, extraPadding = true)
         ChatPreferencesItem(showCustomModal, stopped = stopped)
         if (appPlatform.isDesktop) {
           SettingsActionItem(painterResource(MR.images.ic_smartphone), stringResource(if (remember { chatModel.remoteHosts }.isEmpty()) MR.strings.link_a_mobile else MR.strings.linked_mobiles), showModal { ConnectMobileView(it) }, disabled = stopped, extraPadding = true)
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserAddressView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserAddressView.kt
index d03b75856..98989a775 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserAddressView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserAddressView.kt
@@ -33,10 +33,12 @@ import chat.simplex.res.MR
 @Composable
 fun UserAddressView(
   chatModel: ChatModel,
+  rhId: Long?,
   viaCreateLinkView: Boolean = false,
   shareViaProfile: Boolean = false,
   close: () -> Unit
 ) {
+  // TODO close when remote host changes
   val shareViaProfile = remember { mutableStateOf(shareViaProfile) }
   var progressIndicator by remember { mutableStateOf(false) }
   val onCloseHandler: MutableState<(close: () -> Unit) -> Unit> = remember { mutableStateOf({ _ -> }) }
@@ -45,7 +47,7 @@ fun UserAddressView(
     progressIndicator = true
     withBGApi {
       try {
-        val u = chatModel.controller.apiSetProfileAddress(on)
+        val u = chatModel.controller.apiSetProfileAddress(rhId, on)
         if (u != null) {
           chatModel.updateUser(u)
         }
@@ -67,7 +69,7 @@ fun UserAddressView(
       createAddress = {
         withApi {
           progressIndicator = true
-          val connReqContact = chatModel.controller.apiCreateUserAddress()
+          val connReqContact = chatModel.controller.apiCreateUserAddress(rhId)
           if (connReqContact != null) {
             chatModel.userAddress.value = UserContactLinkRec(connReqContact)
 
@@ -112,7 +114,7 @@ fun UserAddressView(
           onConfirm = {
             progressIndicator = true
             withApi {
-              val u = chatModel.controller.apiDeleteUserAddress()
+              val u = chatModel.controller.apiDeleteUserAddress(rhId)
               if (u != null) {
                 chatModel.userAddress.value = null
                 chatModel.updateUser(u)
@@ -126,7 +128,7 @@ fun UserAddressView(
       },
       saveAas = { aas: AutoAcceptState, savedAAS: MutableState<AutoAcceptState> ->
         withBGApi {
-          val address = chatModel.controller.userAddressAutoAccept(aas.autoAccept)
+          val address = chatModel.controller.userAddressAutoAccept(rhId, aas.autoAccept)
           if (address != null) {
             chatModel.userAddress.value = address
             savedAAS.value = aas
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserProfileView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserProfileView.kt
index ea4ef79d4..4bc2d9241 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserProfileView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserProfileView.kt
@@ -37,10 +37,10 @@ fun UserProfileView(chatModel: ChatModel, close: () -> Unit) {
       close,
       saveProfile = { displayName, fullName, image ->
         withApi {
-          val updated = chatModel.controller.apiUpdateProfile(profile.copy(displayName = displayName.trim(), fullName = fullName, image = image))
+          val updated = chatModel.controller.apiUpdateProfile(user.remoteHostId, profile.copy(displayName = displayName.trim(), fullName = fullName, image = image))
           if (updated != null) {
             val (newProfile, _) = updated
-            chatModel.updateCurrentUser(newProfile)
+            chatModel.updateCurrentUser(user.remoteHostId, newProfile)
             profile = newProfile
             close()
           }
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserProfilesView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserProfilesView.kt
index 7d3239700..ec6d4e196 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserProfilesView.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserProfilesView.kt
@@ -57,7 +57,7 @@ fun UserProfilesView(m: ChatModel, search: MutableState<String>, profileHidden:
         ModalManager.end.closeModals()
       }
       withBGApi {
-        m.controller.changeActiveUser(user.userId, userViewPassword(user, searchTextOrPassword.value.trim()))
+        m.controller.changeActiveUser(user.remoteHostId, user.userId, userViewPassword(user, searchTextOrPassword.value.trim()))
       }
     },
     removeUser = { user ->
@@ -106,24 +106,24 @@ fun UserProfilesView(m: ChatModel, search: MutableState<String>, profileHidden:
         ModalManager.start.showModalCloseable(true) { close ->
           ProfileActionView(UserProfileAction.UNHIDE, user) { pwd ->
             withBGApi {
-              setUserPrivacy(m) { m.controller.apiUnhideUser(user.userId, pwd) }
+              setUserPrivacy(m) { m.controller.apiUnhideUser(user, pwd) }
               close()
             }
           }
         }
       } else {
-        withBGApi { setUserPrivacy(m) { m.controller.apiUnhideUser(user.userId, searchTextOrPassword.value.trim()) } }
+        withBGApi { setUserPrivacy(m) { m.controller.apiUnhideUser(user, searchTextOrPassword.value.trim()) } }
       }
     },
     muteUser = { user ->
       withBGApi {
         setUserPrivacy(m, onSuccess = {
           if (m.controller.appPrefs.showMuteProfileAlert.get()) showMuteProfileAlert(m.controller.appPrefs.showMuteProfileAlert)
-        }) { m.controller.apiMuteUser(user.userId) }
+        }) { m.controller.apiMuteUser(user) }
       }
     },
     unmuteUser = { user ->
-      withBGApi { setUserPrivacy(m) { m.controller.apiUnmuteUser(user.userId) } }
+      withBGApi { setUserPrivacy(m) { m.controller.apiUnmuteUser(user) } }
     },
     showHiddenProfile = { user ->
       ModalManager.start.showModalCloseable(true) { close ->
@@ -348,14 +348,14 @@ private suspend fun doRemoveUser(m: ChatModel, user: User, users: List<User>, de
   if (users.size < 2) return
 
   suspend fun deleteUser(user: User) {
-    m.controller.apiDeleteUser(user.userId, delSMPQueues, viewPwd)
+    m.controller.apiDeleteUser(user, delSMPQueues, viewPwd)
     m.removeUser(user)
   }
   try {
     if (user.activeUser) {
       val newActive = users.firstOrNull { u -> !u.activeUser && !u.hidden }
       if (newActive != null) {
-        m.controller.changeActiveUser_(newActive.userId, null)
+        m.controller.changeActiveUser_(newActive.remoteHostId, newActive.userId, null)
         deleteUser(user.copy(activeUser = false))
       }
     } else {
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/call/CallView.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/call/CallView.desktop.kt
index cce8a3ce8..c2665109f 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/call/CallView.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/call/CallView.desktop.kt
@@ -50,22 +50,23 @@ actual fun ActiveCallView() {
     val call = chatModel.activeCall.value
     if (call != null) {
       Log.d(TAG, "has active call $call")
+      val callRh = call.remoteHostId
       when (val r = apiMsg.resp) {
         is WCallResponse.Capabilities -> withBGApi {
           val callType = CallType(call.localMedia, r.capabilities)
-          chatModel.controller.apiSendCallInvitation(call.contact, callType)
+          chatModel.controller.apiSendCallInvitation(callRh, call.contact, callType)
           chatModel.activeCall.value = call.copy(callState = CallState.InvitationSent, localCapabilities = r.capabilities)
         }
         is WCallResponse.Offer -> withBGApi {
-          chatModel.controller.apiSendCallOffer(call.contact, r.offer, r.iceCandidates, call.localMedia, r.capabilities)
+          chatModel.controller.apiSendCallOffer(callRh, call.contact, r.offer, r.iceCandidates, call.localMedia, r.capabilities)
           chatModel.activeCall.value = call.copy(callState = CallState.OfferSent, localCapabilities = r.capabilities)
         }
         is WCallResponse.Answer -> withBGApi {
-          chatModel.controller.apiSendCallAnswer(call.contact, r.answer, r.iceCandidates)
+          chatModel.controller.apiSendCallAnswer(callRh, call.contact, r.answer, r.iceCandidates)
           chatModel.activeCall.value = call.copy(callState = CallState.Negotiated)
         }
         is WCallResponse.Ice -> withBGApi {
-          chatModel.controller.apiSendCallExtraInfo(call.contact, r.iceCandidates)
+          chatModel.controller.apiSendCallExtraInfo(callRh, call.contact, r.iceCandidates)
         }
         is WCallResponse.Connection ->
           try {
@@ -73,7 +74,7 @@ actual fun ActiveCallView() {
             if (callStatus == WebRTCCallStatus.Connected) {
               chatModel.activeCall.value = call.copy(callState = CallState.Connected, connectedAt = Clock.System.now())
             }
-            withBGApi { chatModel.controller.apiCallStatus(call.contact, callStatus) }
+            withBGApi { chatModel.controller.apiCallStatus(callRh, call.contact, callStatus) }
           } catch (e: Error) {
             Log.d(TAG, "call status ${r.state.connectionState} not used")
           }
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.desktop.kt
index d2fa97f86..61e0e0d3c 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.desktop.kt
@@ -44,7 +44,7 @@ actual fun DesktopActiveCallOverlayLayout(newChatSheetState: MutableStateFlow<An
                 val chat = chatModel.getChat(call.contact.id)
                 if (chat != null) {
                   withApi {
-                    openChat(chat.chatInfo, chatModel)
+                    openChat(chat.remoteHostId, chat.chatInfo, chatModel)
                   }
                 }
               },
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.desktop.kt
index 84da0a775..6d56a7b51 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/newchat/ConnectViaLinkView.desktop.kt
@@ -4,6 +4,7 @@ import androidx.compose.runtime.*
 import chat.simplex.common.model.ChatModel
 
 @Composable
-actual fun ConnectViaLinkView(m: ChatModel, close: () -> Unit) {
-  PasteToConnectView(m, close)
+actual fun ConnectViaLinkView(m: ChatModel, rhId: Long?, close: () -> Unit) {
+  // TODO this should close if remote host changes in model
+  PasteToConnectView(m, rhId, close)
 }
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.desktop.kt
index f202318f1..540de40a9 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/newchat/ScanToConnectView.desktop.kt
@@ -4,9 +4,10 @@ import androidx.compose.runtime.Composable
 import chat.simplex.common.model.ChatModel
 
 @Composable
-actual fun ScanToConnectView(chatModel: ChatModel, close: () -> Unit) {
+actual fun ScanToConnectView(chatModel: ChatModel, rhId: Long?, close: () -> Unit) {
   ConnectContactLayout(
     chatModel = chatModel,
+    rhId = rhId,
     incognitoPref = chatModel.controller.appPrefs.incognito,
     close = close
   )
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.desktop.kt
index 464c28631..2d436dbbf 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/usersettings/ScanProtocolServer.desktop.kt
@@ -4,6 +4,6 @@ import androidx.compose.runtime.Composable
 import chat.simplex.common.model.ServerCfg
 
 @Composable
-actual fun ScanProtocolServer(onNext: (ServerCfg) -> Unit) {
-  ScanProtocolServerLayout(onNext)
+actual fun ScanProtocolServer(rhId: Long?, onNext: (ServerCfg) -> Unit) {
+  ScanProtocolServerLayout(rhId, onNext)
 }

From 07ef2a0b6473f1ae16ae60372f54505e22d9e5e6 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 20 Nov 2023 10:20:31 +0000
Subject: [PATCH 67/69] android: remove ACCESS_WIFI_STATE (#3391)

---
 apps/multiplatform/android/src/main/AndroidManifest.xml | 1 -
 1 file changed, 1 deletion(-)

diff --git a/apps/multiplatform/android/src/main/AndroidManifest.xml b/apps/multiplatform/android/src/main/AndroidManifest.xml
index 459b1bc05..09b33316a 100644
--- a/apps/multiplatform/android/src/main/AndroidManifest.xml
+++ b/apps/multiplatform/android/src/main/AndroidManifest.xml
@@ -15,7 +15,6 @@
   <uses-permission android:name="android.permission.RECEIVE_BOOT_COMPLETED" />
   <uses-permission android:name="android.permission.VIBRATE" />
   <uses-permission android:name="android.permission.INTERNET" />
-  <uses-permission android:name="android.permission.ACCESS_WIFI_STATE" />
   <uses-permission android:name="android.permission.ACCESS_NETWORK_STATE" />
   <uses-permission android:name="android.permission.WRITE_EXTERNAL_STORAGE"
       tools:ignore="ScopedStorage" />

From c536ca7f0f81dc72905e9e56caccb767652c2621 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 20 Nov 2023 10:34:24 +0000
Subject: [PATCH 68/69] core: add events not sent to connected remote desktop
 (#3402)

---
 src/Simplex/Chat/Controller.hs | 24 ++++++++++++++++++------
 1 file changed, 18 insertions(+), 6 deletions(-)

diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 2ccc2ca12..7533649c6 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -686,17 +686,29 @@ data ChatResponse
   | CRTimedAction {action :: String, durationMilliseconds :: Int64}
   deriving (Show)
 
+-- some of these can only be used as command responses
 allowRemoteEvent :: ChatResponse -> Bool
 allowRemoteEvent = \case
-  CRRemoteHostList {} -> False
-  CRRemoteHostConnected {} -> False
-  CRRemoteHostStopped {} -> False
-  CRRemoteCtrlList {} -> False
-  CRRemoteCtrlFound {} -> False
+  CRChatStarted -> False
+  CRChatRunning -> False
+  CRChatStopped -> False
+  CRChatSuspended -> False
+  CRRemoteHostList _ -> False
+  CRCurrentRemoteHost _ -> False
+  CRRemoteHostStarted {} -> False
+  CRRemoteHostSessionCode {} -> False
+  CRNewRemoteHost _ -> False
+  CRRemoteHostConnected _ -> False
+  CRRemoteHostStopped _ -> False
+  CRRemoteFileStored {} -> False
+  CRRemoteCtrlList _ -> False
+  CRRemoteCtrlFound _ -> False
   CRRemoteCtrlConnecting {} -> False
   CRRemoteCtrlSessionCode {} -> False
-  CRRemoteCtrlConnected {} -> False
+  CRRemoteCtrlConnected _ -> False
   CRRemoteCtrlStopped -> False
+  CRSQLResult _ -> False
+  CRSlowSQLQueries {} -> False
   _ -> True
 
 logResponseToFile :: ChatResponse -> Bool

From 718436bf55ec2fca22e028b51bc138e1c6fb81e9 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Mon, 20 Nov 2023 15:27:15 +0400
Subject: [PATCH 69/69] core: don't read all group members where unnecessary
 (#3403)

---
 src/Simplex/Chat.hs | 79 +++++++++++++++++++++------------------------
 1 file changed, 36 insertions(+), 43 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 5ec22602f..06a603584 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -3252,10 +3252,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
         pure $ updateEntityConnStatus acEntity connStatus
       Nothing -> pure acEntity
 
-    isMember :: MemberId -> GroupInfo -> [GroupMember] -> Bool
-    isMember memId GroupInfo {membership} members =
-      sameMemberId memId membership || isJust (find (sameMemberId memId) members)
-
     agentMsgConnStatus :: ACommand 'Agent e -> Maybe ConnStatus
     agentMsgConnStatus = \case
       CONF {} -> Just ConnRequested
@@ -3533,7 +3529,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
           _ -> messageError "INFO from member must have x.grp.mem.info, x.info or x.ok"
         pure ()
       CON -> do
-        members <- withStore' $ \db -> getGroupMembers db user gInfo
         withStore' $ \db -> do
           updateGroupMemberStatus db userId m GSMemConnected
           unless (memberActive membership) $
@@ -3553,6 +3548,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
             toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected}
             let Connection {viaUserContactLink} = conn
             when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem
+            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 ->
@@ -4943,11 +4939,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
     xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> RcvMessage -> UTCTime -> m ()
     xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ memberProfile) msg brokerTs = do
       checkHostRole m memRole
-      members <- withStore' $ \db -> getGroupMembers db user gInfo
       unless (sameMemberId memId $ membership gInfo) $
-        if isMember memId gInfo members
-          then messageError "x.grp.mem.new error: member already exists"
-          else do
+        withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case
+          Right _ -> messageError "x.grp.mem.new error: member already exists"
+          Left _ -> do
             newMember@GroupMember {groupMemberId} <- withStore $ \db -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced
             ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile)
             groupMsgToView gInfo ci
@@ -4956,11 +4951,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
     xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> m ()
     xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) = do
       case memberCategory m of
-        GCHostMember -> do
-          members <- withStore' $ \db -> getGroupMembers db user gInfo
-          if isMember memId gInfo members
-            then messageWarning "x.grp.mem.intro ignored: member already exists"
-            else do
+        GCHostMember ->
+          withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case
+            Right _ -> messageError "x.grp.mem.intro ignored: member already exists"
+            Left _ -> do
               when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c)
               subMode <- chatReadVar subscriptionMode
               -- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second
@@ -4986,11 +4980,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
     xGrpMemInv :: GroupInfo -> GroupMember -> MemberId -> IntroInvitation -> m ()
     xGrpMemInv gInfo@GroupInfo {groupId} m memId introInv = do
       case memberCategory m of
-        GCInviteeMember -> do
-          members <- withStore' $ \db -> getGroupMembers db user gInfo
-          case find (sameMemberId memId) members of
-            Nothing -> messageError "x.grp.mem.inv error: referenced member does not exist"
-            Just reMember -> do
+        GCInviteeMember ->
+          withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case
+            Left _ -> messageError "x.grp.mem.inv error: referenced member does not exist"
+            Right reMember -> do
               GroupMemberIntro {introId} <- withStore $ \db -> saveIntroInvitation db reMember m introInv
               void . sendGroupMessage' user [reMember] (XGrpMemFwd (memberInfo m) introInv) groupId (Just introId) $
                 withStore' $ \db -> updateIntroStatus db introId GMIntroInvForwarded
@@ -4999,14 +4992,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
     xGrpMemFwd :: GroupInfo -> GroupMember -> MemberInfo -> IntroInvitation -> m ()
     xGrpMemFwd gInfo@GroupInfo {membership, chatSettings} m memInfo@(MemberInfo memId memRole memChatVRange _) introInv@IntroInvitation {groupConnReq, directConnReq} = do
       checkHostRole m memRole
-      members <- withStore' $ \db -> getGroupMembers db user gInfo
-      toMember <- case find (sameMemberId memId) members of
-        -- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent
-        -- the situation when member does not exist is an error
-        -- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that.
-        -- For now, this branch compensates for the lack of delayed message delivery.
-        Nothing -> withStore $ \db -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced
-        Just m' -> pure m'
+      toMember <-
+        withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case
+          -- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent
+          -- the situation when member does not exist is an error
+          -- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that.
+          -- For now, this branch compensates for the lack of delayed message delivery.
+          Left _ -> withStore $ \db -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced
+          Right m' -> pure m'
       withStore' $ \db -> saveMemberInvitation db toMember introInv
       subMode <- chatReadVar subscriptionMode
       -- [incognito] send membership incognito profile, create direct connection as incognito
@@ -5023,11 +5016,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
       | membership.memberId == memId =
         let gInfo' = gInfo {membership = membership {memberRole = memRole}}
          in changeMemberRole gInfo' membership $ RGEUserRole memRole
-      | otherwise = do
-        members <- withStore' $ \db -> getGroupMembers db user gInfo
-        case find (sameMemberId memId) members of
-          Just member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole
-          _ -> messageError "x.grp.mem.role with unknown member ID"
+      | otherwise =
+        withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case
+          Right member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole
+          Left _ -> messageError "x.grp.mem.role with unknown member ID"
       where
         changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} gEvent
           | senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions"
@@ -5081,25 +5073,26 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
 
     xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> UTCTime -> m ()
     xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId msg brokerTs = do
-      members <- withStore' $ \db -> getGroupMembers db user gInfo
       if membership.memberId == memId
         then checkRole membership $ do
           deleteGroupLinkIfExists user gInfo
           -- member records are not deleted to keep history
+          members <- withStore' $ \db -> getGroupMembers db user gInfo
           deleteMembersConnections user members
           withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemRemoved
           deleteMemberItem RGEUserDeleted
           toView $ CRDeletedMemberUser user gInfo {membership = membership {memberStatus = GSMemRemoved}} m
-        else case find (sameMemberId memId) members of
-          Nothing -> messageError "x.grp.mem.del with unknown member ID"
-          Just member@GroupMember {groupMemberId, memberProfile} ->
-            checkRole member $ do
-              -- ? prohibit deleting member if it's the sender - sender should use x.grp.leave
-              deleteMemberConnection user member
-              -- undeleted "member connected" chat item will prevent deletion of member record
-              deleteOrUpdateMemberRecord user member
-              deleteMemberItem $ RGEMemberDeleted groupMemberId (fromLocalProfile memberProfile)
-              toView $ CRDeletedMember user gInfo m member {memberStatus = GSMemRemoved}
+        else
+          withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case
+            Left _ -> messageError "x.grp.mem.del with unknown member ID"
+            Right member@GroupMember {groupMemberId, memberProfile} ->
+              checkRole member $ do
+                -- ? prohibit deleting member if it's the sender - sender should use x.grp.leave
+                deleteMemberConnection user member
+                -- undeleted "member connected" chat item will prevent deletion of member record
+                deleteOrUpdateMemberRecord user member
+                deleteMemberItem $ RGEMemberDeleted groupMemberId (fromLocalProfile memberProfile)
+                toView $ CRDeletedMember user gInfo m member {memberStatus = GSMemRemoved}
       where
         checkRole GroupMember {memberRole} a
           | senderRole < GRAdmin || senderRole < memberRole =