Plug discovery into remote controller UI

src/Simplex/Chat.hs

@@ -72,6 +72,7 @@ import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Groups
 import Simplex.Chat.Store.Messages
 import Simplex.Chat.Store.Profiles
+import Simplex.Chat.Store.Remote
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
@@ -1864,11 +1865,56 @@ processChatCommand = \case
   DisposeRemoteHost _rh -> pure $ chatCmdError Nothing "not supported"
   RegisterRemoteCtrl _displayName _oobData -> pure $ chatCmdError Nothing "not supported"
   ListRemoteCtrls -> pure $ chatCmdError Nothing "not supported"
-  StartRemoteCtrl -> pure $ chatCmdError Nothing "not supported"
-  ConfirmRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
-  RejectRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
-  StopRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
-  DisposeRemoteCtrl _rc -> pure $ chatCmdError Nothing "not supported"
+  StartRemoteCtrl ->
+    chatReadVar remoteCtrlSession >>= \case
+      Just _busy -> throwError $ ChatErrorRemoteCtrl RCEBusy
+      Nothing -> do
+        uio <- askUnliftIO
+        accepted <- newEmptyTMVarIO
+        let getControllers = unliftIO uio $ withStore' $ \db ->
+              map (\RemoteCtrl{remoteCtrlId, fingerprint} -> (fingerprint, remoteCtrlId)) <$> getRemoteCtrls (DB.conn db)
+        let started remoteCtrlId = unliftIO uio $ do
+              withStore' (\db -> getRemoteCtrl (DB.conn db) remoteCtrlId) >>= \case
+                Nothing -> pure False
+                Just RemoteCtrl{displayName, accepted=resolution} -> case resolution of
+                  Nothing -> do
+                    -- started/finished wrapper is synchronous, running HTTP server can be delayed here until UI processes the first contact dialogue
+                    toView $ CRRemoteCtrlFirstContact {remoteCtrlId, displayName}
+                    atomically $ takeTMVar accepted
+                  Just known -> atomically $ putTMVar accepted known $> known
+        let finished remoteCtrlId todo'error = unliftIO uio $ do
+              chatWriteVar remoteCtrlSession Nothing
+              toView $ CRRemoteCtrlDisconnected {remoteCtrlId}
+        let process rc req = unliftIO uio $ processControllerCommand rc req
+        ctrlAsync <- async . liftIO $ Discovery.runDiscoverer getControllers started finished process
+        chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {ctrlAsync, accepted}
+        pure CRRemoteCtrlStarted
+  ConfirmRemoteCtrl remoteCtrlId -> do
+    chatReadVar remoteCtrlSession >>= \case
+      Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
+      Just RemoteCtrlSession {accepted} -> do
+        withStore' $ \db -> markRemoteCtrlResolution (DB.conn db) remoteCtrlId True
+        atomically $ putTMVar accepted True
+        pure $ CRRemoteCtrlAccepted {remoteCtrlId}
+  RejectRemoteCtrl remoteCtrlId -> do
+    chatReadVar remoteCtrlSession >>= \case
+      Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
+      Just RemoteCtrlSession {accepted} -> do
+        withStore' $ \db -> markRemoteCtrlResolution (DB.conn db) remoteCtrlId False
+        atomically $ putTMVar accepted False
+        pure $ CRRemoteCtrlRejected {remoteCtrlId}
+  StopRemoteCtrl remoteCtrlId ->
+    chatReadVar remoteCtrlSession >>= \case
+      Nothing -> throwError $ ChatErrorRemoteCtrl RCEInactive
+      Just RemoteCtrlSession {ctrlAsync} -> do
+        cancel ctrlAsync
+        pure $ CRRemoteCtrlDisconnected {remoteCtrlId}
+  DisposeRemoteCtrl remoteCtrlId ->
+    chatReadVar remoteCtrlSession >>= \case
+      Nothing -> do
+        withStore' $ \db -> deleteRemoteCtrl (DB.conn db) remoteCtrlId
+        pure $ CRRemoteCtrlDisposed {remoteCtrlId}
+      Just _ -> throwError $ ChatErrorRemoteCtrl RCEBusy
   QuitChat -> liftIO exitSuccess
   ShowVersion -> do
     let versionInfo = coreVersionInfo $(simplexmqCommitQ)

src/Simplex/Chat/Controller.hs

@@ -422,7 +422,7 @@ data ChatCommand
   | StartRemoteCtrl -- ^ Start listening for announcements from all registered controllers
   | ListRemoteCtrls
   | ConfirmRemoteCtrl RemoteCtrlId -- ^ Confirm discovered data and store confirmation
-  | RejectRemoteCtrl RemoteCtrlId -- ^ Reject discovered data (and blacklist?)
+  | RejectRemoteCtrl RemoteCtrlId -- ^ Reject and blacklist discovered data
   | StopRemoteCtrl RemoteCtrlId -- ^ Stop listening for announcements or terminate an active session
   | DisposeRemoteCtrl RemoteCtrlId -- ^ Remove all local data associated with a satellite session
   | QuitChat
@@ -602,9 +602,11 @@ data ChatResponse
   | CRRemoteHostDisposed {remoteHostId :: RemoteHostId}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlRegistered {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlStarted
+  | CRRemoteCtrlFirstContact {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
   | CRRemoteCtrlAccepted {remoteCtrlId :: RemoteCtrlId}
   | CRRemoteCtrlRejected {remoteCtrlId :: RemoteCtrlId}
-  | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId}
+  | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
   | CRRemoteCtrlDisconnected {remoteCtrlId :: RemoteCtrlId}
   | CRSQLResult {rows :: [Text]}
   | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
@@ -906,7 +908,7 @@ data ChatError
   | ChatErrorAgent {agentError :: AgentErrorType, connectionEntity_ :: Maybe ConnectionEntity}
   | ChatErrorStore {storeError :: StoreError}
   | ChatErrorDatabase {databaseError :: DatabaseError}
-  | ChatErrorRemoteCtrl {remoteCtrlId :: RemoteCtrlId, remoteControllerError :: RemoteCtrlError}
+  | ChatErrorRemoteCtrl {remoteControllerError :: RemoteCtrlError}
   | ChatErrorRemoteHost {remoteHostId :: RemoteHostId, remoteHostError :: RemoteHostError}
   deriving (Show, Exception, Generic)
 
@@ -1036,13 +1038,14 @@ instance ToJSON RemoteHostError where
 
 -- TODO review errors, some of it can be covered by HTTP2 errors
 data RemoteCtrlError
-  = RCEMissing -- ^ No remote session matches this identifier
+  = RCEMissing {remoteCtrlId :: RemoteCtrlId} -- ^ No remote session matches this identifier
+  | RCEInactive -- ^ No session is running
   | RCEBusy -- ^ A session is already running
   | RCETimeout -- ^ Remote operation timed out
-  | RCEDisconnected {reason :: Text} -- ^ A session disconnected by a controller
-  | RCEConnectionLost {reason :: Text} -- ^ A session disconnected due to transport issues
-  | RCECertificateExpired -- ^ A connection or CA certificate in a chain have bad validity period
-  | RCECertificateUntrusted -- ^ TLS is unable to validate certificate chain presented for a connection
+  | RCEDisconnected {remoteCtrlId :: RemoteCtrlId, reason :: Text} -- ^ A session disconnected by a controller
+  | RCEConnectionLost {remoteCtrlId :: RemoteCtrlId, reason :: Text} -- ^ A session disconnected due to transport issues
+  | RCECertificateExpired {remoteCtrlId :: RemoteCtrlId} -- ^ A connection or CA certificate in a chain have bad validity period
+  | RCECertificateUntrusted {remoteCtrlId :: RemoteCtrlId} -- ^ TLS is unable to validate certificate chain presented for a connection
   deriving (Show, Exception, Generic)
 
 instance FromJSON RemoteCtrlError where

src/Simplex/Chat/Migrations/M20230922_remote_controller.hs

@@ -19,7 +19,8 @@ CREATE TABLE remote_hosts ( -- hosts known to a controlling app
 CREATE TABLE remote_controllers ( -- controllers known to a hosting app
   remote_controller_id INTEGER PRIMARY KEY,
   display_name TEXT NOT NULL,
-  fingerprint BLOB NOT NULL
+  fingerprint BLOB NOT NULL,
+  accepted INTEGER
 );
 |]
 

src/Simplex/Chat/Remote.hs

@@ -10,9 +10,9 @@ module Simplex.Chat.Remote where
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import qualified Data.Aeson as J
+import qualified Data.Binary.Builder as Binary
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.Map.Strict as M
-import qualified Data.Binary.Builder as Binary
 import qualified Network.HTTP.Types as HTTP
 import qualified Network.HTTP2.Client as HTTP2Client
 import Simplex.Chat.Controller
@@ -20,43 +20,44 @@ import Simplex.Chat.Remote.Types
 import Simplex.Chat.Types
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HTTP2
-import Simplex.Messaging.Util	(bshow)
+import qualified Simplex.Messaging.Transport.HTTP2.Server as HTTP2
+import Simplex.Messaging.Util (bshow)
 import System.Directory (getFileSize)
 
-withRemoteHostSession :: ChatMonad m => RemoteHostId -> (RemoteHostSession -> m a) -> m a
+withRemoteHostSession :: (ChatMonad m) => RemoteHostId -> (RemoteHostSession -> m a) -> m a
 withRemoteHostSession remoteHostId action = do
   chatReadVar remoteHostSessions >>= maybe err action . M.lookup remoteHostId
   where
     err = throwError $ ChatErrorRemoteHost remoteHostId RHMissing
 
-closeRemoteHostSession :: ChatMonad m => RemoteHostId -> m ()
+closeRemoteHostSession :: (ChatMonad m) => RemoteHostId -> m ()
 closeRemoteHostSession rh = withRemoteHostSession rh (liftIO . HTTP2.closeHTTP2Client . ctrlClient)
 
-processRemoteCommand :: ChatMonad m => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
+processRemoteCommand :: (ChatMonad m) => RemoteHostSession -> (ByteString, ChatCommand) -> m ChatResponse
 processRemoteCommand rhs = \case
   -- XXX: intercept and filter some commands
   -- TODO: store missing files on remote host
   (s, _cmd) -> relayCommand rhs s
 
-relayCommand :: ChatMonad m => RemoteHostSession -> ByteString -> m ChatResponse
-relayCommand RemoteHostSession {ctrlClient} s = postBytestring Nothing ctrlClient "/relay" mempty s >>= \case
-  Left e -> error "TODO: http2chatError"
-  Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
-    remoteChatResponse <-
-      if iTax then
-        case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
-          Left e -> error "TODO: json2chatError" e
-          Right (raw :: J.Value) -> case J.fromJSON (sum2tagged raw) of
-            J.Error e -> error "TODO: json2chatError" e
-            J.Success cr -> pure cr
-      else
-        case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
-          Left e -> error "TODO: json2chatError" e
-          Right cr -> pure cr
-    case remoteChatResponse of
-      -- TODO: intercept file responses and fetch files when needed
-      -- XXX: is that even possible, to have a file response to a command?
-      _ -> pure remoteChatResponse
+relayCommand :: (ChatMonad m) => RemoteHostSession -> ByteString -> m ChatResponse
+relayCommand RemoteHostSession {ctrlClient} s =
+  postBytestring Nothing ctrlClient "/relay" mempty s >>= \case
+    Left e -> error "TODO: http2chatError"
+    Right HTTP2.HTTP2Response {respBody = HTTP2Body {bodyHead}} -> do
+      remoteChatResponse <-
+        if iTax
+          then case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
+            Left e -> error "TODO: json2chatError" e
+            Right (raw :: J.Value) -> case J.fromJSON (sum2tagged raw) of
+              J.Error e -> error "TODO: json2chatError" e
+              J.Success cr -> pure cr
+          else case J.eitherDecodeStrict bodyHead of -- XXX: large JSONs can overflow into buffered chunks
+            Left e -> error "TODO: json2chatError" e
+            Right cr -> pure cr
+      case remoteChatResponse of
+        -- TODO: intercept file responses and fetch files when needed
+        -- XXX: is that even possible, to have a file response to a command?
+        _ -> pure remoteChatResponse
   where
     iTax = True -- TODO: get from RemoteHost
     -- XXX: extract to http2 transport
@@ -64,11 +65,11 @@ relayCommand RemoteHostSession {ctrlClient} s = postBytestring Nothing ctrlClien
       where
         req = HTTP2Client.requestBuilder "POST" path hs (Binary.fromByteString body)
 
-storeRemoteFile :: ChatMonad m => RemoteHostSession -> FilePath -> m ChatResponse
+storeRemoteFile :: (ChatMonad m) => RemoteHostSession -> FilePath -> m ChatResponse
 storeRemoteFile RemoteHostSession {ctrlClient} localFile = do
   postFile Nothing ctrlClient "/store" mempty localFile >>= \case
     Left e -> error "TODO: http2chatError"
-    Right HTTP2.HTTP2Response { response } -> case HTTP.statusCode <$> HTTP2Client.responseStatus response of
+    Right HTTP2.HTTP2Response {response} -> case HTTP.statusCode <$> HTTP2Client.responseStatus response of
       Just 200 -> pure $ CRCmdOk Nothing
       unexpected -> error "TODO: http2chatError"
   where
@@ -78,7 +79,7 @@ storeRemoteFile RemoteHostSession {ctrlClient} localFile = do
       where
         req size = HTTP2Client.requestFile "POST" path hs (HTTP2Client.FileSpec file 0 size)
 
-fetchRemoteFile :: ChatMonad m => RemoteHostSession -> FileTransferId -> m ChatResponse
+fetchRemoteFile :: (ChatMonad m) => RemoteHostSession -> FileTransferId -> m ChatResponse
 fetchRemoteFile RemoteHostSession {ctrlClient, storePath} remoteFileId = do
   liftIO (HTTP2.sendRequest ctrlClient req Nothing) >>= \case
     Left e -> error "TODO: http2chatError"
@@ -93,3 +94,12 @@ sum2tagged :: J.Value -> J.Value
 sum2tagged = \case
   J.Object todo'convert -> J.Object todo'convert
   skip -> skip
+
+-- withRemoteCtrlSession :: (ChatMonad m) => RemoteCtrlId -> (RemoteCtrlSession -> m a) -> m a
+-- withRemoteCtrlSession remoteCtrlId action = do
+--   chatReadVar remoteHostSessions >>= maybe err action . M.lookup remoteCtrlId
+--   where
+--     err = throwError $ ChatErrorRemoteCtrl (Just remoteCtrlId) RCMissing
+
+processControllerCommand :: (ChatMonad m) => RemoteCtrlId -> HTTP2.HTTP2Request -> m ()
+processControllerCommand rc req = error "TODO: processControllerCommand"

src/Simplex/Chat/Remote/Discovery.hs

@@ -10,19 +10,13 @@ module Simplex.Chat.Remote.Discovery
 where
 
 import Control.Monad
-import Data.ByteString.Builder (Builder, intDec)
 import Data.Default (def)
 import Data.String (IsString)
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
 import Debug.Trace
-import qualified Network.HTTP.Types as HTTP
-import qualified Network.HTTP2.Server as HTTP2
 import qualified Network.Socket as N
 import qualified Network.TLS as TLS
 import qualified Network.UDP as UDP
-import Simplex.Chat.Controller (ChatMonad)
-import Simplex.Chat.Types ()
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Transport (supportedParameters)
 import qualified Simplex.Messaging.Transport as Transport
@@ -34,7 +28,7 @@ import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTran
 import UnliftIO
 import UnliftIO.Concurrent
 
-runAnnouncer :: (StrEncoding invite, ChatMonad m) => IO () -> invite -> TLS.Credentials -> m (Either HTTP2ClientError HTTP2Client)
+runAnnouncer :: (StrEncoding invite, MonadUnliftIO m) => IO () -> invite -> TLS.Credentials -> m (Either HTTP2ClientError HTTP2Client)
 runAnnouncer finished invite credentials = do
   started <- newEmptyTMVarIO
   aPid <- async $ announcer started (strEncode invite)
@@ -76,57 +70,38 @@ broadcastAddrV4 = "255.255.255.255"
 partyPort :: (IsString a) => a
 partyPort = "5226" -- XXX: should be `0` or something, to get a random port and announce it
 
-runDiscoverer :: (ChatMonad m) => Text -> m ()
-runDiscoverer oobData =
-  case strDecode (encodeUtf8 oobData) of
-    Left err -> traceM $ "oobData decode error: " <> err
-    Right expected -> liftIO $ do
-      traceM $ "runDiscoverer: locating " <> show oobData
-      sock <- UDP.serverSocket (broadcastAddrV4, read partyPort)
-      N.setSocketOption (UDP.listenSocket sock) N.Broadcast 1
-      traceM $ "runDiscoverer: " <> show sock
-      go sock expected
+runDiscoverer :: IO [(C.KeyHash, ctx)] -> (ctx -> IO Bool) -> (ctx -> Maybe SomeException -> IO ()) -> (ctx -> HTTP2Request -> IO ()) -> IO ()
+runDiscoverer getFingerprints started finished processRequest = do
+  sock <- UDP.serverSocket (broadcastAddrV4, read partyPort)
+  N.setSocketOption (UDP.listenSocket sock) N.Broadcast 1
+  traceM $ "runDiscoverer: " <> show sock
+  go sock
   where
-    go sock expected = do
+    go sock = do
       (invite, UDP.ClientSockAddr source _cmsg) <- UDP.recvFrom sock
-      traceShowM (invite, source)
-      let expect hash = hash `elem` [expected] -- XXX: can be a callback to fetch actual invite list just in time
       case strDecode invite of
         Left err -> do
           traceM $ "Inivite decode error: " <> err
-          go sock expected
-        Right inviteHash | not (expect inviteHash) -> do
-          traceM $ "Skipping unexpected invite " <> show (strEncode inviteHash)
-          go sock expected
-        Right _expected -> do
-          host <- case source of
-            N.SockAddrInet _port addr -> do
-              pure $ THIPv4 (N.hostAddressToTuple addr)
-            unexpected ->
-              -- TODO: actually, Apple mandates IPv6 support
-              fail $ "Discoverer: expected an IPv4 party, got " <> show unexpected
-          traceM $ "Discoverer: go connect " <> show host
-          runTransportClient defaultTransportClientConfig Nothing host partyPort (Just expected) $ \tls -> do
-            traceM "2PTTH server starting"
-            run tls
-            traceM "2PTTH server finished"
-
-    run tls = runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
-      reqBody <- getHTTP2Body r 16384
-      processRequest HTTP2Request {sessionId, request = r, reqBody, sendResponse}
-
-    processRequest req = do
-      traceM $ "Got request: " <> show (request req)
-      -- TODO: sendResponse req . HTTP2.promiseResponse $ HTTP2.pushPromise path response weight
-      sendResponse req $ HTTP2.responseStreaming HTTP.ok200 sseHeaders sseExample
-
-    sseHeaders = [(HTTP.hContentType, "text/event-stream")]
-
-    sseExample :: (Builder -> IO ()) -> IO () -> IO ()
-    sseExample write flush = forM_ [1 .. 10] $ \i -> do
-      let payload = "[" <> intDec i <> ", \"blah\"]"
-      write "event: message\n" -- XXX: SSE header line
-      write $ "data: " <> payload <> "\n" -- XXX: SSE payload line
-      write "\n" -- XXX: SSE delimiter
-      flush
-      threadDelay 1000000
+          go sock
+        Right inviteHash -> do
+          expected <- getFingerprints
+          case lookup inviteHash expected of
+            Nothing -> do
+              traceM $ "Unexpected invite: " <> show (invite, source)
+              go sock
+            Just ctx -> do
+              host <- case source of
+                N.SockAddrInet _port addr -> do
+                  pure $ THIPv4 (N.hostAddressToTuple addr)
+                unexpected ->
+                  -- TODO: actually, Apple mandates IPv6 support
+                  fail $ "Discoverer: expected an IPv4 party, got " <> show unexpected
+              runTransportClient defaultTransportClientConfig Nothing host partyPort (Just inviteHash) $ \tls -> do
+                accepted <- started ctx
+                if not accepted
+                  then go sock -- Ignore rejected invites and wait for another
+                  else do
+                    res <- try $ runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
+                      reqBody <- getHTTP2Body r 16384
+                      processRequest ctx HTTP2Request {sessionId, request = r, reqBody, sendResponse}
+                    finished ctx $ either Just (\() -> Nothing) res

src/Simplex/Chat/Remote/Types.hs

@@ -8,6 +8,7 @@ import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
+import UnliftIO.STM
 
 type RemoteHostId = Int64
 
@@ -22,12 +23,13 @@ data RemoteHost = RemoteHost
     caKey :: C.Key
   }
 
-type RemoteCtrlId = Int
+type RemoteCtrlId = Int64
 
 data RemoteCtrl = RemoteCtrl
   { remoteCtrlId :: RemoteCtrlId,
     displayName :: Text,
-    fingerprint :: Text
+    fingerprint :: C.KeyHash,
+    accepted :: Maybe Bool
   }
 
 data RemoteHostSession = RemoteHostSession
@@ -36,9 +38,8 @@ data RemoteHostSession = RemoteHostSession
     ctrlClient :: HTTP2Client
   }
 
--- | Host-side dual to RemoteHostSession, on-methods represent HTTP API.
 data RemoteCtrlSession = RemoteCtrlSession
-  { -- | process to communicate with the remote controller
-    ctrlAsync :: Async ()
-    -- server :: HTTP2Server
+  { -- | Server side of transport to process remote commands and forward notifications
+    ctrlAsync :: Async (),
+    accepted :: TMVar Bool
   }

src/Simplex/Chat/Store/Remote.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -7,7 +8,7 @@ import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Database.SQLite.Simple as DB
-import Simplex.Chat.Remote.Types (RemoteHostId, RemoteHost (..))
+import Simplex.Chat.Remote.Types (RemoteCtrl (..), RemoteCtrlId, RemoteHost (..), RemoteHostId)
 import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow)
 import qualified Simplex.Messaging.Crypto as C
 
@@ -26,3 +27,27 @@ remoteHostQuery = "SELECT remote_host_id, display_name, store_path, ca_cert, ca_
 toRemoteHost :: (Int64, Text, FilePath, ByteString, C.Key) -> RemoteHost
 toRemoteHost (remoteHostId, displayName, storePath, caCert, caKey) =
   RemoteHost {remoteHostId, displayName, storePath, caCert, caKey}
+
+getRemoteCtrls :: DB.Connection -> IO [RemoteCtrl]
+getRemoteCtrls db =
+  map toRemoteCtrl <$> DB.query_ db remoteCtrlQuery
+
+getRemoteCtrl :: DB.Connection -> RemoteCtrlId -> IO (Maybe RemoteCtrl)
+getRemoteCtrl db remoteCtrlId =
+  maybeFirstRow toRemoteCtrl $
+    DB.query db (remoteCtrlQuery <> "WHERE remote_controller_id = ?") (DB.Only remoteCtrlId)
+
+remoteCtrlQuery :: DB.Query
+remoteCtrlQuery = "SELECT remote_controller_id, display_name, fingerprint, accepted FROM remote_controllers"
+
+toRemoteCtrl :: (Int64, Text, C.KeyHash, Maybe Bool) -> RemoteCtrl
+toRemoteCtrl (remoteCtrlId, displayName, fingerprint, accepted) =
+  RemoteCtrl {remoteCtrlId, displayName, fingerprint, accepted}
+
+markRemoteCtrlResolution :: DB.Connection -> RemoteCtrlId -> Bool -> IO ()
+markRemoteCtrlResolution db remoteCtrlId accepted =
+  DB.execute db "UPDATE remote_controllers SET accepted = ? WHERE remote_controller_id = ?" (accepted, remoteCtrlId)
+
+deleteRemoteCtrl :: DB.Connection -> RemoteCtrlId -> IO ()
+deleteRemoteCtrl db remoteCtrlId =
+  DB.execute db "DELETE FROM remote_controllers WHERE remote_controller_id = ?" (DB.Only remoteCtrlId)

src/Simplex/Chat/View.hs

@@ -1678,7 +1678,7 @@ viewChatError logLevel = \case
         Nothing -> ""
       cId :: Connection -> StyledString
       cId conn = sShow conn.connId
-  ChatErrorRemoteCtrl remoteCtrlId todo'rc -> [sShow remoteCtrlId, sShow todo'rc]
+  ChatErrorRemoteCtrl todo'rc -> [sShow todo'rc]
   ChatErrorRemoteHost remoteHostId todo'rh -> [sShow remoteHostId, sShow todo'rh]
   where
     fileNotFound fileId = ["file " <> sShow fileId <> " not found"]