mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
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>
This commit is contained in:
Alexander Bondarenko
committed by
GitHub
GitHub
parent
3839267f88
commit
b729144773
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user