dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-06-06 01:23:11 +00:00
Code Issues Packages Projects Releases Wiki Activity

add remote host bindings (#3471)

Browse Source 
* add remote host bindings

* group iface/address together

* rename migration

* add implementation

* update view and api

* bump upstream

* add schema

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
Alexander Bondarenko
2023-11-28 18:32:33 +02:00
committed by GitHub
parent 950bbe19da
commit 6a21d5c7f1
14 changed files with 139 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Store/Migrations.hs
+3 -1
View File
@@ -90,6 +90,7 @@ import Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
import Simplex.Chat.Migrations.M20231107_indexes
import Simplex.Chat.Migrations.M20231113_group_forward
import Simplex.Chat.Migrations.M20231114_remote_control
import Simplex.Chat.Migrations.M20231126_remote_ctrl_address
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -179,7 +180,8 @@ schemaMigrations =
("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received),
("20231107_indexes", m20231107_indexes, Just down_m20231107_indexes),
("20231113_group_forward", m20231113_group_forward, Just down_m20231113_group_forward),
("20231114_remote_control", m20231114_remote_control, Just down_m20231114_remote_control)
("20231114_remote_control", m20231114_remote_control, Just down_m20231114_remote_control),
("20231126_remote_ctrl_address", m20231126_remote_ctrl_address, Just down_m20231126_remote_ctrl_address)
]
-- | The list of migrations in ascending order by date
src/Simplex/Chat/Store/Remote.hs
+25 -13
View File
@@ -8,6 +8,8 @@ module Simplex.Chat.Store.Remote where
import Control.Monad.Except
import Data.Int (Int64)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8, decodeASCII)
import Data.Word (Word16)
import Database.SQLite.Simple (Only (..))
import qualified Database.SQLite.Simple as SQL
import Database.SQLite.Simple.QQ (sql)
@@ -16,11 +18,12 @@ 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.Messaging.Encoding.String (StrEncoding (..))
import Simplex.RemoteControl.Types
import UnliftIO
insertRemoteHost :: DB.Connection -> Text -> FilePath -> RCHostPairing -> ExceptT StoreError IO RemoteHostId
insertRemoteHost db hostDeviceName storePath RCHostPairing {caKey, caCert, idPrivKey, knownHost = kh_} = do
insertRemoteHost :: DB.Connection -> Text -> FilePath -> Maybe RCCtrlAddress -> Maybe Word16 -> RCHostPairing -> ExceptT StoreError IO RemoteHostId
insertRemoteHost db hostDeviceName storePath rcAddr_ bindPort_ RCHostPairing {caKey, caCert, idPrivKey, knownHost = kh_} = do
KnownHostPairing {hostFingerprint, hostDhPubKey} <-
maybe (throwError SERemoteHostUnknown) pure kh_
checkConstraint SERemoteHostDuplicateCA . liftIO $
@@ -28,12 +31,14 @@ insertRemoteHost db hostDeviceName storePath RCHostPairing {caKey, caCert, idPri
db
[sql|
INSERT INTO remote_hosts
(host_device_name, store_path, ca_key, ca_cert, id_key, host_fingerprint, host_dh_pub)
(host_device_name, store_path, bind_addr, bind_iface, bind_port, ca_key, ca_cert, id_key, host_fingerprint, host_dh_pub)
VALUES
(?, ?, ?, ?, ?, ?, ?)
(?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
|]
(hostDeviceName, storePath, caKey, C.SignedObject caCert, idPrivKey, hostFingerprint, hostDhPubKey)
(hostDeviceName, storePath, bindAddr_, bindIface_, bindPort_, caKey, C.SignedObject caCert, idPrivKey, hostFingerprint, hostDhPubKey)
liftIO $ insertedRowId db
where
(bindAddr_, bindIface_) = rcCtrlAddressFields_ rcAddr_
getRemoteHosts :: DB.Connection -> IO [RemoteHost]
getRemoteHosts db =
@@ -52,27 +57,34 @@ getRemoteHostByFingerprint db fingerprint =
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
SELECT remote_host_id, host_device_name, store_path, ca_key, ca_cert, id_key, host_fingerprint, host_dh_pub, bind_iface, bind_addr, bind_port
FROM remote_hosts
|]
toRemoteHost :: (Int64, Text, FilePath, C.APrivateSignKey, C.SignedObject C.Certificate, C.PrivateKeyEd25519, C.KeyHash, C.PublicKeyX25519) -> RemoteHost
toRemoteHost (remoteHostId, hostDeviceName, storePath, caKey, C.SignedObject caCert, idPrivKey, hostFingerprint, hostDhPubKey) =
RemoteHost {remoteHostId, hostDeviceName, storePath, hostPairing}
toRemoteHost :: (Int64, Text, FilePath, C.APrivateSignKey, C.SignedObject C.Certificate, C.PrivateKeyEd25519, C.KeyHash, C.PublicKeyX25519, Maybe Text, Maybe Text, Maybe Word16) -> RemoteHost
toRemoteHost (remoteHostId, hostDeviceName, storePath, caKey, C.SignedObject caCert, idPrivKey, hostFingerprint, hostDhPubKey, ifaceName_, ifaceAddr_, bindPort_) =
RemoteHost {remoteHostId, hostDeviceName, storePath, hostPairing, bindAddress_, bindPort_}
where
hostPairing = RCHostPairing {caKey, caCert, idPrivKey, knownHost = Just knownHost}
knownHost = KnownHostPairing {hostFingerprint, hostDhPubKey}
bindAddress_ = RCCtrlAddress <$> (decodeAddr <$> ifaceAddr_) <*> ifaceName_
decodeAddr = either (error "Error parsing TransportHost") id . strDecode . encodeUtf8
updateHostPairing :: DB.Connection -> RemoteHostId -> Text -> C.PublicKeyX25519 -> IO ()
updateHostPairing db rhId hostDeviceName hostDhPubKey =
updateHostPairing :: DB.Connection -> RemoteHostId -> Text -> C.PublicKeyX25519 -> Maybe RCCtrlAddress -> Maybe Word16 -> IO ()
updateHostPairing db rhId hostDeviceName hostDhPubKey rcAddr_ bindPort_ =
DB.execute
db
[sql|
UPDATE remote_hosts
SET host_device_name = ?, host_dh_pub = ?
SET host_device_name = ?, host_dh_pub = ?, bind_addr = ?, bind_iface = ?, bind_port = ?
WHERE remote_host_id = ?
|]
(hostDeviceName, hostDhPubKey, rhId)
(hostDeviceName, hostDhPubKey, bindAddr_, bindIface_, bindPort_, rhId)
where
(bindAddr_, bindIface_) = rcCtrlAddressFields_ rcAddr_
rcCtrlAddressFields_ :: Maybe RCCtrlAddress -> (Maybe Text, Maybe Text)
rcCtrlAddressFields_ = maybe (Nothing, Nothing) $ \RCCtrlAddress {address, interface} -> (Just . decodeASCII $ strEncode address, Just interface)
deleteRemoteHostRecord :: DB.Connection -> RemoteHostId -> IO ()
deleteRemoteHostRecord db remoteHostId = DB.execute db "DELETE FROM remote_hosts WHERE remote_host_id = ?" (Only remoteHostId)