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

Add commands for remote session credentials (#3161)

Browse Source 
* Add remote host commands

* Make startRemoteHost async

* Add tests

* Trim randomStorePath to 16 chars

* Add chat command tests

* add view, use view output in test

* enable all tests

* Fix discovery listener host

Must use any, not broadcast on macos.

* Fix missing do

* address, names

* Fix session host flow

* fix test

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
Alexander Bondarenko
2023-10-04 18:36:10 +03:00
committed by GitHub
parent bf7917bd67
commit 0bcf5c9c66
13 changed files with 515 additions and 197 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Store/Remote.hs
+28 -14
View File
@@ -4,14 +4,20 @@
module Simplex.Chat.Store.Remote where
import Data.ByteString.Char8 (ByteString)
import Data.Int (Int64)
import Data.Text (Text)
import qualified Database.SQLite.Simple as DB
import Database.SQLite.Simple (Only (..))
import qualified Database.SQLite.Simple as SQL
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Chat.Remote.Types (RemoteCtrl (..), RemoteCtrlId, RemoteHost (..), RemoteHostId)
import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow)
import qualified Simplex.Messaging.Crypto as C
insertRemoteHost :: DB.Connection -> FilePath -> Text -> C.APrivateSignKey -> C.SignedCertificate -> IO RemoteHostId
insertRemoteHost db storePath displayName caKey caCert = do
DB.execute db "INSERT INTO remote_hosts (store_path, display_name, ca_key, ca_cert) VALUES (?,?,?,?)" (storePath, displayName, caKey, C.SignedObject caCert)
fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
getRemoteHosts :: DB.Connection -> IO [RemoteHost]
getRemoteHosts db =
map toRemoteHost <$> DB.query_ db remoteHostQuery
@@ -19,14 +25,22 @@ getRemoteHosts db =
getRemoteHost :: DB.Connection -> RemoteHostId -> IO (Maybe RemoteHost)
getRemoteHost db remoteHostId =
maybeFirstRow toRemoteHost $
DB.query db (remoteHostQuery <> "WHERE remote_host_id = ?") (DB.Only remoteHostId)
DB.query db (remoteHostQuery <> " WHERE remote_host_id = ?") (Only remoteHostId)
remoteHostQuery :: DB.Query
remoteHostQuery = "SELECT remote_host_id, display_name, store_path, ca_cert, ca_key FROM remote_hosts"
remoteHostQuery :: SQL.Query
remoteHostQuery = "SELECT remote_host_id, store_path, display_name, ca_key, ca_cert, contacted FROM remote_hosts"
toRemoteHost :: (Int64, Text, FilePath, ByteString, C.Key) -> RemoteHost
toRemoteHost (remoteHostId, displayName, storePath, caCert, caKey) =
RemoteHost {remoteHostId, displayName, storePath, caCert, caKey}
toRemoteHost :: (Int64, FilePath, Text, C.APrivateSignKey, C.SignedObject C.Certificate, Bool) -> RemoteHost
toRemoteHost (remoteHostId, storePath, displayName, caKey, C.SignedObject caCert, contacted) =
RemoteHost {remoteHostId, storePath, displayName, caKey, caCert, contacted}
deleteRemoteHostRecord :: DB.Connection -> RemoteHostId -> IO ()
deleteRemoteHostRecord db remoteHostId = DB.execute db "DELETE FROM remote_hosts WHERE remote_host_id = ?" (Only remoteHostId)
insertRemoteCtrl :: DB.Connection -> Text -> C.KeyHash -> IO RemoteCtrlId
insertRemoteCtrl db displayName fingerprint = do
DB.execute db "INSERT INTO remote_controllers (display_name, fingerprint) VALUES (?,?)" (displayName, fingerprint)
fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
getRemoteCtrls :: DB.Connection -> IO [RemoteCtrl]
getRemoteCtrls db =
@@ -35,14 +49,14 @@ getRemoteCtrls db =
getRemoteCtrl :: DB.Connection -> RemoteCtrlId -> IO (Maybe RemoteCtrl)
getRemoteCtrl db remoteCtrlId =
maybeFirstRow toRemoteCtrl $
DB.query db (remoteCtrlQuery <> "WHERE remote_controller_id = ?") (DB.Only remoteCtrlId)
DB.query db (remoteCtrlQuery <> " WHERE remote_controller_id = ?") (Only remoteCtrlId)
getRemoteCtrlByFingerprint :: DB.Connection -> C.KeyHash -> IO (Maybe RemoteCtrl)
getRemoteCtrlByFingerprint db fingerprint =
maybeFirstRow toRemoteCtrl $
DB.query db (remoteCtrlQuery <> "WHERE fingerprint = ?") (DB.Only fingerprint)
DB.query db (remoteCtrlQuery <> " WHERE fingerprint = ?") (Only fingerprint)
remoteCtrlQuery :: DB.Query
remoteCtrlQuery :: SQL.Query
remoteCtrlQuery = "SELECT remote_controller_id, display_name, fingerprint, accepted FROM remote_controllers"
toRemoteCtrl :: (Int64, Text, C.KeyHash, Maybe Bool) -> RemoteCtrl
@@ -53,6 +67,6 @@ markRemoteCtrlResolution :: DB.Connection -> RemoteCtrlId -> Bool -> IO ()
markRemoteCtrlResolution db remoteCtrlId accepted =
DB.execute db "UPDATE remote_controllers SET accepted = ? WHERE remote_controller_id = ? AND accepted IS NULL" (accepted, remoteCtrlId)
deleteRemoteCtrl :: DB.Connection -> RemoteCtrlId -> IO ()
deleteRemoteCtrl db remoteCtrlId =
DB.execute db "DELETE FROM remote_controllers WHERE remote_controller_id = ?" (DB.Only remoteCtrlId)
deleteRemoteCtrlRecord :: DB.Connection -> RemoteCtrlId -> IO ()
deleteRemoteCtrlRecord db remoteCtrlId =
DB.execute db "DELETE FROM remote_controllers WHERE remote_controller_id = ?" (Only remoteCtrlId)