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>
2025-03-14 09:45:42 +00:00 · 2023-11-08 22:13:52 +02:00 · 2023-11-08 22:13:52 +02:00 · b729144773
commit b729144773
parent 3839267f88
18 changed files with 761 additions and 581 deletions
--- 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
--- 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";
--- 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
--- 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),
--- 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)
--- 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
 );
 |]

--- 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,
--- 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 #-}
--- a/src/Simplex/Chat/Remote/AppVersion.hs
+++ 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)
--- 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 ()
--- 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
--- 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)
--- 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)
--- 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)
--- 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
--- 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
--- 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
    }
--- 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