From 86fe28f1ed6980e824fe9f02fd9f059045aa5d20 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 29 Mar 2024 18:30:17 +0000 Subject: [PATCH] core: chat hooks allowing to extend or customize chat core (#3953) * core: chat hooks allowing to extend or customize chat core * update * json * custom response * user in db queries --- apps/simplex-chat/Main.hs | 61 ++---------------- apps/simplex-chat/Server.hs | 6 +- .../src/Directory/Events.hs | 2 +- simplex-chat.cabal | 2 + src/Simplex/Chat.hs | 30 ++++++--- src/Simplex/Chat/Controller.hs | 34 ++++++++-- .../Chat/Migrations/M20240324_custom_data.hs | 20 ++++++ src/Simplex/Chat/Migrations/chat_schema.sql | 4 +- src/Simplex/Chat/Store/Connections.hs | 10 +-- src/Simplex/Chat/Store/Direct.hs | 16 +++-- src/Simplex/Chat/Store/Groups.hs | 30 +++++---- src/Simplex/Chat/Store/Messages.hs | 10 +++ src/Simplex/Chat/Store/Migrations.hs | 4 +- src/Simplex/Chat/Store/Shared.hs | 6 +- src/Simplex/Chat/Terminal/Main.hs | 64 +++++++++++++++++++ src/Simplex/Chat/Types.hs | 20 +++++- src/Simplex/Chat/View.hs | 13 ++-- 17 files changed, 223 insertions(+), 109 deletions(-) create mode 100644 src/Simplex/Chat/Migrations/M20240324_custom_data.hs create mode 100644 src/Simplex/Chat/Terminal/Main.hs diff --git a/apps/simplex-chat/Main.hs b/apps/simplex-chat/Main.hs index f47bd6c7c4..41321edc68 100644 --- a/apps/simplex-chat/Main.hs +++ b/apps/simplex-chat/Main.hs @@ -1,61 +1,8 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} - module Main where -import Control.Concurrent (forkIO, threadDelay) -import Control.Concurrent.STM -import Control.Monad -import Data.Time.Clock (getCurrentTime) -import Data.Time.LocalTime (getCurrentTimeZone) -import Server -import Simplex.Chat.Controller (ChatController (..), ChatResponse (..), currentRemoteHost, versionNumber, versionString) -import Simplex.Chat.Core -import Simplex.Chat.Options -import Simplex.Chat.Terminal -import Simplex.Chat.View (serializeChatResponse) -import Simplex.Messaging.Client (NetworkConfig (..)) -import System.Directory (getAppUserDataDirectory) -import System.Terminal (withTerminal) +import Server (simplexChatServer) +import Simplex.Chat.Terminal (terminalChatConfig) +import Simplex.Chat.Terminal.Main (simplexChatCLI) main :: IO () -main = do - appDir <- getAppUserDataDirectory "simplex" - opts@ChatOpts {chatCmd, chatServerPort} <- getChatOpts appDir "simplex_v1" - if null chatCmd - then case chatServerPort of - Just chatPort -> simplexChatServer defaultChatServerConfig {chatPort} terminalChatConfig opts - _ -> runCLI opts - else simplexChatCore terminalChatConfig opts $ runCommand opts - where - runCLI opts = do - welcome opts - t <- withTerminal pure - simplexChatTerminal terminalChatConfig opts t - runCommand ChatOpts {chatCmd, chatCmdLog, chatCmdDelay} user cc = do - when (chatCmdLog /= CCLNone) . void . forkIO . forever $ do - (_, _, r') <- atomically . readTBQueue $ outputQ cc - case r' of - CRNewChatItem {} -> printResponse r' - _ -> when (chatCmdLog == CCLAll) $ printResponse r' - sendChatCmdStr cc chatCmd >>= printResponse - threadDelay $ chatCmdDelay * 1000000 - where - printResponse r = do - ts <- getCurrentTime - tz <- getCurrentTimeZone - rh <- readTVarIO $ currentRemoteHost cc - putStrLn $ serializeChatResponse (rh, Just user) ts tz rh r - -welcome :: ChatOpts -> IO () -welcome ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, networkConfig}} = - mapM_ - putStrLn - [ versionString versionNumber, - "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db", - maybe - "direct network connection - use `/network` command or `-x` CLI option to connect via SOCKS5 at :9050" - (("using SOCKS5 proxy " <>) . show) - (socksProxy networkConfig), - "type \"/help\" or \"/h\" for usage info" - ] +main = simplexChatCLI terminalChatConfig (Just simplexChatServer) diff --git a/apps/simplex-chat/Server.hs b/apps/simplex-chat/Server.hs index 3f4484eac6..58a167e4f5 100644 --- a/apps/simplex-chat/Server.hs +++ b/apps/simplex-chat/Server.hs @@ -28,9 +28,9 @@ import Simplex.Messaging.Util (raceAny_) import UnliftIO.Exception import UnliftIO.STM -simplexChatServer :: ChatServerConfig -> ChatConfig -> ChatOpts -> IO () -simplexChatServer srvCfg cfg opts = - simplexChatCore cfg opts . const $ runChatServer srvCfg +simplexChatServer :: ServiceName -> ChatConfig -> ChatOpts -> IO () +simplexChatServer chatPort cfg opts = + simplexChatCore cfg opts . const $ runChatServer defaultChatServerConfig {chatPort} data ChatServerConfig = ChatServerConfig { chatPort :: ServiceName, diff --git a/apps/simplex-directory-service/src/Directory/Events.hs b/apps/simplex-directory-service/src/Directory/Events.hs index a187ac3e82..1d7a866051 100644 --- a/apps/simplex-directory-service/src/Directory/Events.hs +++ b/apps/simplex-directory-service/src/Directory/Events.hs @@ -70,7 +70,7 @@ crDirectoryEvent = \case CRChatItemDeleted {deletedChatItem = AChatItem _ SMDRcv (DirectChat ct) _, byUser = False} -> Just $ DEItemDeleteIgnored ct CRNewChatItem {chatItem = AChatItem _ SMDRcv (DirectChat ct) ci@ChatItem {content = CIRcvMsgContent mc, meta = CIMeta {itemLive}}} -> Just $ case (mc, itemLive) of - (MCText t, Nothing) -> DEContactCommand ct ciId $ fromRight err $ A.parseOnly directoryCmdP $ T.dropWhileEnd isSpace t + (MCText t, Nothing) -> DEContactCommand ct ciId $ fromRight err $ A.parseOnly (directoryCmdP <* A.endOfInput) $ T.dropWhileEnd isSpace t _ -> DEUnsupportedMessage ct ciId where ciId = chatItemId' ci diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 15eb8add7d..27aab2be9f 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -139,6 +139,7 @@ library Simplex.Chat.Migrations.M20240226_users_restrict Simplex.Chat.Migrations.M20240228_pq Simplex.Chat.Migrations.M20240313_drop_agent_ack_cmd_id + Simplex.Chat.Migrations.M20240324_custom_data Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared @@ -168,6 +169,7 @@ library Simplex.Chat.Styled Simplex.Chat.Terminal Simplex.Chat.Terminal.Input + Simplex.Chat.Terminal.Main Simplex.Chat.Terminal.Notification Simplex.Chat.Terminal.Output Simplex.Chat.Types diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 2a85fb8670..b7e4ab335c 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -161,7 +161,8 @@ defaultChatConfig = ciExpirationInterval = 30 * 60 * 1000000, -- 30 minutes coreApi = False, highlyAvailable = False, - deviceNameForRemote = "" + deviceNameForRemote = "", + chatHooks = defaultChatHooks } _defaultSMPServers :: NonEmpty SMPServerWithAuth @@ -424,7 +425,9 @@ execChatCommand rh s = do Just rhId | allowRemoteCommand cmd -> execRemoteCommand u rhId cmd s | otherwise -> pure $ CRChatCmdError u $ ChatErrorRemoteHost (RHId rhId) $ RHELocalCommand - _ -> execChatCommand_ u cmd + _ -> do + cc@ChatController {config = ChatConfig {chatHooks}} <- ask + liftIO (preCmdHook chatHooks cc cmd) >>= either pure (execChatCommand_ u) execChatCommand' :: ChatMonad' m => ChatCommand -> m ChatResponse execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` cmd) @@ -2094,6 +2097,9 @@ processChatCommand' vr = \case SubInfo {server, subError = Just e} -> M.alter (Just . maybe [e] (e :)) server m _ -> m GetAgentSubsDetails -> CRAgentSubsDetails <$> withAgent getAgentSubscriptions + -- CustomChatCommand is unsupported, it can be processed in preCmdHook + -- in a modified CLI app or core - the hook should return Either ChatResponse ChatCommand + CustomChatCommand _cmd -> withUser $ \user -> pure $ chatCmdError (Just user) "not supported" where withChatLock name action = asks chatLock >>= \l -> withLock l name action -- below code would make command responses asynchronous where they can be slow @@ -4553,25 +4559,28 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = when (sz > fileSize) $ receiveFile' user ft Nothing Nothing >>= toView messageFileDescription :: Contact -> SharedMsgId -> FileDescr -> m () - messageFileDescription Contact {contactId} sharedMsgId fileDescr = do + messageFileDescription ct@Contact {contactId} sharedMsgId fileDescr = do fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId - processFDMessage fileId fileDescr + processFDMessage (CDDirectRcv ct) sharedMsgId fileId fileDescr groupMessageFileDescription :: GroupInfo -> GroupMember -> SharedMsgId -> FileDescr -> m () - groupMessageFileDescription GroupInfo {groupId} _m sharedMsgId fileDescr = do + groupMessageFileDescription g@GroupInfo {groupId} m sharedMsgId fileDescr = do fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId - processFDMessage fileId fileDescr + processFDMessage (CDGroupRcv g m) sharedMsgId fileId fileDescr - processFDMessage :: FileTransferId -> FileDescr -> m () - processFDMessage fileId fileDescr = do + processFDMessage :: ChatTypeQuotable c => ChatDirection c 'MDRcv -> SharedMsgId -> FileTransferId -> FileDescr -> m () + processFDMessage cd sharedMsgId fileId fileDescr = do ft <- withStore $ \db -> getRcvFileTransfer db user fileId unless (rcvFileCompleteOrCancelled ft) $ do - (rfd, RcvFileTransfer {fileStatus, xftpRcvFile, cryptoArgs}) <- withStore $ \db -> do + (rfd@RcvFileDescr {fileDescrComplete}, ft'@RcvFileTransfer {fileStatus, xftpRcvFile, cryptoArgs}) <- withStore $ \db -> do rfd <- appendRcvFD db userId fileId fileDescr -- reading second time in the same transaction as appending description -- to prevent race condition with accept ft' <- getRcvFileTransfer db user fileId pure (rfd, ft') + when fileDescrComplete $ do + ci <- withStore $ \db -> getAChatItemBySharedMsgId db user cd sharedMsgId + toView $ CRRcvFileDescrReady user ci ft' rfd case (fileStatus, xftpRcvFile) of (RFSAccepted _, Just XFTPRcvFile {}) -> receiveViaCompleteFD user fileId rfd cryptoArgs _ -> pure () @@ -7040,7 +7049,8 @@ chatCommandP = "/get subs" $> GetAgentSubs, "/get subs details" $> GetAgentSubsDetails, "/get workers" $> GetAgentWorkers, - "/get workers details" $> GetAgentWorkersDetails + "/get workers details" $> GetAgentWorkersDetails, + "//" *> (CustomChatCommand <$> A.takeByteString) ] where choice = A.choice . map (\p -> p <* A.takeWhile (== ' ') <* A.endOfInput) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 4ca9da094f..c1a278d6d9 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -144,9 +144,28 @@ data ChatConfig = ChatConfig ciExpirationInterval :: Int64, -- microseconds coreApi :: Bool, highlyAvailable :: Bool, - deviceNameForRemote :: Text + deviceNameForRemote :: Text, + chatHooks :: ChatHooks } +-- The hooks can be used to extend or customize chat core in mobile or CLI clients. +data ChatHooks = ChatHooks + { -- preCmdHook can be used to process or modify the commands before they are processed. + -- This hook should be used to process CustomChatCommand. + -- if this hook returns ChatResponse, the command processing will be skipped. + preCmdHook :: ChatController -> ChatCommand -> IO (Either ChatResponse ChatCommand), + -- eventHook can be used to additionally process or modify events, + -- it is called before the event is sent to the user (or to the UI). + eventHook :: ChatController -> ChatResponse -> IO ChatResponse + } + +defaultChatHooks :: ChatHooks +defaultChatHooks = + ChatHooks + { preCmdHook = \_ -> pure . Right, + eventHook = \_ -> pure + } + data DefaultAgentServers = DefaultAgentServers { smp :: NonEmpty SMPServerWithAuth, ntf :: [NtfServer], @@ -471,6 +490,9 @@ data ChatCommand | GetAgentSubsDetails | GetAgentWorkers | GetAgentWorkersDetails + -- The parser will return this command for strings that start from "//". + -- This command should be processed in preCmdHook + | CustomChatCommand ByteString deriving (Show) allowRemoteCommand :: ChatCommand -> Bool -- XXX: consider using Relay/Block/ForceLocal @@ -597,10 +619,9 @@ data ChatResponse | CRContactRequestAlreadyAccepted {user :: User, contact :: Contact} | CRLeftMemberUser {user :: User, groupInfo :: GroupInfo} | CRGroupDeletedUser {user :: User, groupInfo :: GroupInfo} - | CRRcvFileDescrReady {user :: User, chatItem :: AChatItem} + | CRRcvFileDescrReady {user :: User, chatItem :: AChatItem, rcvFileTransfer :: RcvFileTransfer, rcvFileDescr :: RcvFileDescr} | CRRcvFileAccepted {user :: User, chatItem :: AChatItem} | CRRcvFileAcceptedSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer} - | CRRcvFileDescrNotReady {user :: User, chatItem :: AChatItem} | CRStandaloneFileInfo {fileMeta :: Maybe J.Value} | CRRcvStandaloneFileCreated {user :: User, rcvFileTransfer :: RcvFileTransfer} -- returned by _download | CRRcvFileStart {user :: User, chatItem :: AChatItem} -- sent by chats @@ -726,6 +747,7 @@ data ChatResponse | CRArchiveImported {archiveErrors :: [ArchiveError]} | CRAppSettings {appSettings :: AppSettings} | CRTimedAction {action :: String, durationMilliseconds :: Int64} + | CRCustomChatResponse {user_ :: Maybe User, response :: Text} deriving (Show) -- some of these can only be used as command responses @@ -1278,9 +1300,9 @@ throwChatError = throwError . ChatError -- | Emit local events. toView :: ChatMonad' m => ChatResponse -> m () -toView event = do - localQ <- asks outputQ - session <- asks remoteCtrlSession +toView ev = do + cc@ChatController {outputQ = localQ, remoteCtrlSession = session, config = ChatConfig {chatHooks}} <- ask + event <- liftIO $ eventHook chatHooks cc ev atomically $ readTVar session >>= \case Just (_, RCSessionConnected {remoteOutputQ}) diff --git a/src/Simplex/Chat/Migrations/M20240324_custom_data.hs b/src/Simplex/Chat/Migrations/M20240324_custom_data.hs new file mode 100644 index 0000000000..bc1c4807eb --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20240324_custom_data.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20240324_custom_data where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20240324_custom_data :: Query +m20240324_custom_data = + [sql| +ALTER TABLE contacts ADD COLUMN custom_data BLOB; +ALTER TABLE groups ADD COLUMN custom_data BLOB; +|] + +down_m20240324_custom_data :: Query +down_m20240324_custom_data = + [sql| +ALTER TABLE contacts DROP COLUMN custom_data; +ALTER TABLE groups DROP COLUMN custom_data; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 13e8b8b460..11cbd8ae89 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -73,6 +73,7 @@ CREATE TABLE contacts( REFERENCES group_members(group_member_id) ON DELETE SET NULL, contact_grp_inv_sent INTEGER NOT NULL DEFAULT 0, contact_status TEXT NOT NULL DEFAULT 'active', + custom_data BLOB, FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE @@ -120,7 +121,8 @@ CREATE TABLE groups( favorite INTEGER NOT NULL DEFAULT 0, send_rcpts INTEGER, via_group_link_uri_hash BLOB, - user_member_profile_sent_at TEXT, -- received + user_member_profile_sent_at TEXT, + custom_data BLOB, -- received FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index f8e9fa3401..6584aabb0a 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -75,19 +75,19 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do [sql| SELECT c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.via_group, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite, - p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.contact_group_member_id, c.contact_grp_inv_sent + p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.contact_group_member_id, c.contact_grp_inv_sent, c.custom_data FROM contacts c JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id WHERE c.user_id = ? AND c.contact_id = ? AND c.deleted = 0 |] (userId, contactId) - toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)] -> Either StoreError Contact - toContact' contactId conn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)] = + toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool, Maybe CustomData)] -> Either StoreError Contact + toContact' contactId conn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, customData)] = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn activeConn = Just conn - in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} + in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, customData} toContact' _ _ _ = Left $ SEInternalError "referenced contact not found" getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember) getGroupAndMember_ groupMemberId c = ExceptT $ do @@ -99,7 +99,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, - g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, + g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.custom_data, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 47174a59a6..ba2586b0ca 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -68,6 +68,7 @@ module Simplex.Chat.Store.Direct updateContactSettings, setConnConnReqInv, resetContactConnInitiated, + setContactCustomData, ) where @@ -175,7 +176,7 @@ getContactByConnReqHash db vr user@User {userId} cReqHash = SELECT -- Contact ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite, - cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, + cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.custom_data, -- Connection c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, @@ -221,7 +222,7 @@ createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p let profile = toLocalProfile profileId p localAlias userPreferences = emptyChatPrefs mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn - pure $ Contact {contactId, localDisplayName, profile, activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False} + pure $ Contact {contactId, localDisplayName, profile, activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, customData = Nothing} deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO () deleteContactConnectionsAndFiles db userId Contact {contactId} = do @@ -578,7 +579,7 @@ createOrUpdateContactRequest db vr user@User {userId} userContactLinkId invId (V SELECT -- Contact ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite, - cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, + cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.custom_data, -- Connection c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, @@ -724,7 +725,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences} contactId <- insertedRowId db conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId connChatVersion cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode pqSup let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn - pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False} + pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False, customData = Nothing} getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64 getContactIdByName db User {userId} cName = @@ -743,7 +744,7 @@ getContact_ db vr user@User {userId} contactId deleted = SELECT -- Contact ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite, - cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, + cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.custom_data, -- Connection c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, @@ -883,3 +884,8 @@ resetContactConnInitiated db User {userId} Connection {connId} = do WHERE user_id = ? AND connection_id = ? |] (updatedAt, userId, connId) + +setContactCustomData :: DB.Connection -> User -> Contact -> Maybe CustomData -> IO () +setContactCustomData db User {userId} Contact {contactId} customData = do + updatedAt <- getCurrentTime + DB.execute db "UPDATE contacts SET custom_data = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (customData, updatedAt, userId, contactId) diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 254b8dab59..832b928012 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -116,6 +116,7 @@ module Simplex.Chat.Store.Groups createNewUnknownGroupMember, updateUnknownMemberAnnounced, updateUserMemberProfileSentAt, + setGroupCustomData, ) where @@ -148,19 +149,19 @@ import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>)) import Simplex.Messaging.Version import UnliftIO.STM -type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. GroupMemberRow +type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime, Maybe CustomData) :. GroupMemberRow type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences)) type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences)) toGroupInfo :: (PQSupport -> VersionRangeChat) -> Int64 -> GroupInfoRow -> GroupInfo -toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. userMemberRow) = +toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt, customData) :. userMemberRow) = let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr PQSupportOff} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} fullGroupPreferences = mergeGroupPreferences groupPreferences groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences} - in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt} + in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, customData} toGroupMember :: Int64 -> GroupMemberRow -> GroupMember toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) = @@ -271,7 +272,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr = -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, - g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, + g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.custom_data, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, @@ -344,7 +345,8 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, - userMemberProfileSentAt = Just currentTs + userMemberProfileSentAt = Just currentTs, + customData = Nothing } -- | creates a new group record for the group the current user was invited to, or returns an existing one @@ -409,7 +411,8 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, - userMemberProfileSentAt = Just currentTs + userMemberProfileSentAt = Just currentTs, + customData = Nothing }, groupMemberId ) @@ -628,7 +631,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, - g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, + g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.custom_data, mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences FROM groups g @@ -1293,7 +1296,7 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, - g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, + g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.custom_data, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, @@ -1389,7 +1392,7 @@ getGroupInfo db vr User {userId, userContactId} groupId = -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, - g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, + g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.custom_data, -- GroupMember - membership mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, @@ -1951,7 +1954,7 @@ createMemberContact authErrCounter = 0 } mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn - pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False} + pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, customData = Nothing} getMemberContact :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation) getMemberContact db vr user contactId = do @@ -1988,7 +1991,7 @@ createMemberContactInvited contactId <- createContactUpdateMember currentTs userPreferences ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn - mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False} + mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, customData = Nothing} m' = m {memberContactId = Just contactId} pure (mCt', m') where @@ -2188,3 +2191,8 @@ updateUserMemberProfileSentAt db User {userId} GroupInfo {groupId} sentTs = db "UPDATE groups SET user_member_profile_sent_at = ? WHERE user_id = ? AND group_id = ?" (sentTs, userId, groupId) + +setGroupCustomData :: DB.Connection -> User -> GroupInfo -> Maybe CustomData -> IO () +setGroupCustomData db User {userId} GroupInfo {groupId} customData = do + updatedAt <- getCurrentTime + DB.execute db "UPDATE groups SET custom_data = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (customData, updatedAt, userId, groupId) diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index cc0199b214..fe89d7f506 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -41,6 +41,7 @@ module Simplex.Chat.Store.Messages getDirectChatItemLast, getAllChatItems, getAChatItem, + getAChatItemBySharedMsgId, updateDirectChatItem, updateDirectChatItem', addInitialAndNewCIVersions, @@ -2202,6 +2203,15 @@ getAChatItem db vr user chatRef itemId = case chatRef of pure $ AChatItem SCTLocal msgDir (LocalChat nf) ci _ -> throwError $ SEChatItemNotFound itemId +getAChatItemBySharedMsgId :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> SharedMsgId -> ExceptT StoreError IO AChatItem +getAChatItemBySharedMsgId db user cd sharedMsgId = case cd of + CDDirectRcv ct@Contact {contactId} -> do + (CChatItem msgDir ci) <- getDirectChatItemBySharedMsgId db user contactId sharedMsgId + pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci + CDGroupRcv g@GroupInfo {groupId} GroupMember {groupMemberId} -> do + (CChatItem msgDir ci) <- getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId + pure $ AChatItem SCTGroup msgDir (GroupChat g) ci + getChatItemVersions :: DB.Connection -> ChatItemId -> IO [ChatItemVersion] getChatItemVersions db itemId = do map toChatItemVersion diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index 60fae44da8..e351f0f27a 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -103,6 +103,7 @@ import Simplex.Chat.Migrations.M20240222_app_settings import Simplex.Chat.Migrations.M20240226_users_restrict import Simplex.Chat.Migrations.M20240228_pq import Simplex.Chat.Migrations.M20240313_drop_agent_ack_cmd_id +import Simplex.Chat.Migrations.M20240324_custom_data import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -205,7 +206,8 @@ schemaMigrations = ("20240222_app_settings", m20240222_app_settings, Just down_m20240222_app_settings), ("20240226_users_restrict", m20240226_users_restrict, Just down_m20240226_users_restrict), ("20240228_pq", m20240228_pq, Just down_m20240228_pq), - ("20240313_drop_agent_ack_cmd_id", m20240313_drop_agent_ack_cmd_id, Just down_m20240313_drop_agent_ack_cmd_id) + ("20240313_drop_agent_ack_cmd_id", m20240313_drop_agent_ack_cmd_id, Just down_m20240313_drop_agent_ack_cmd_id), + ("20240324_custom_data", m20240324_custom_data, Just down_m20240324_custom_data) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 5c4a5a7e9b..dc75ad50e9 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -371,16 +371,16 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId = |] [":user_id" := userId, ":profile_id" := profileId] -type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool) +type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool, Maybe CustomData) toContact :: (PQSupport -> VersionRangeChat) -> User -> ContactRow :. MaybeConnectionRow -> Contact -toContact vr user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) = +toContact vr user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, customData)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} activeConn = toMaybeConnection vr connRow chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} incognito = maybe False connIncognito activeConn mergedPreferences = contactUserPreferences user userPreferences preferences incognito - in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} + in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, customData} getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile getProfileById db userId profileId = diff --git a/src/Simplex/Chat/Terminal/Main.hs b/src/Simplex/Chat/Terminal/Main.hs new file mode 100644 index 0000000000..2b26bb1d66 --- /dev/null +++ b/src/Simplex/Chat/Terminal/Main.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} + +module Simplex.Chat.Terminal.Main where + +import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent.STM +import Control.Monad +import Data.Time.Clock (getCurrentTime) +import Data.Time.LocalTime (getCurrentTimeZone) +import Network.Socket +import Simplex.Chat.Controller (ChatConfig, ChatController (..), ChatResponse (..), currentRemoteHost, versionNumber, versionString) +import Simplex.Chat.Core +import Simplex.Chat.Options +import Simplex.Chat.Terminal +import Simplex.Chat.View (serializeChatResponse) +import Simplex.Messaging.Client (NetworkConfig (..)) +import System.Directory (getAppUserDataDirectory) +import System.Exit (exitFailure) +import System.Terminal (withTerminal) + +simplexChatCLI :: ChatConfig -> Maybe (ServiceName -> ChatConfig -> ChatOpts -> IO ()) -> IO () +simplexChatCLI cfg server_ = do + appDir <- getAppUserDataDirectory "simplex" + opts@ChatOpts {chatCmd, chatServerPort} <- getChatOpts appDir "simplex_v1" + if null chatCmd + then case chatServerPort of + Just chatPort -> case server_ of + Just server -> server chatPort cfg opts + Nothing -> putStrLn "Not allowed to run as a WebSockets server" >> exitFailure + _ -> runCLI opts + else simplexChatCore cfg opts $ runCommand opts + where + runCLI opts = do + welcome opts + t <- withTerminal pure + simplexChatTerminal cfg opts t + runCommand ChatOpts {chatCmd, chatCmdLog, chatCmdDelay} user cc = do + when (chatCmdLog /= CCLNone) . void . forkIO . forever $ do + (_, _, r') <- atomically . readTBQueue $ outputQ cc + case r' of + CRNewChatItem {} -> printResponse r' + _ -> when (chatCmdLog == CCLAll) $ printResponse r' + sendChatCmdStr cc chatCmd >>= printResponse + threadDelay $ chatCmdDelay * 1000000 + where + printResponse r = do + ts <- getCurrentTime + tz <- getCurrentTimeZone + rh <- readTVarIO $ currentRemoteHost cc + putStrLn $ serializeChatResponse (rh, Just user) ts tz rh r + +welcome :: ChatOpts -> IO () +welcome ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, networkConfig}} = + mapM_ + putStrLn + [ versionString versionNumber, + "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db", + maybe + "direct network connection - use `/network` command or `-x` CLI option to connect via SOCKS5 at :9050" + (("using SOCKS5 proxy " <>) . show) + (socksProxy networkConfig), + "type \"/help\" or \"/h\" for usage info" + ] diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index ab8b66a7d4..e419f8c4cb 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -174,10 +174,25 @@ data Contact = Contact updatedAt :: UTCTime, chatTs :: Maybe UTCTime, contactGroupMemberId :: Maybe GroupMemberId, - contactGrpInvSent :: Bool + contactGrpInvSent :: Bool, + customData :: Maybe CustomData } deriving (Eq, Show) +newtype CustomData = CustomData J.Object + deriving (Eq, Show) + +instance ToJSON CustomData where + toJSON (CustomData v) = toJSON v + toEncoding (CustomData v) = toEncoding v + +instance FromJSON CustomData where + parseJSON = J.withObject "CustomData" (pure . CustomData) + +instance ToField CustomData where toField (CustomData v) = toField $ J.encode v + +instance FromField CustomData where fromField = fromBlobField_ J.eitherDecodeStrict + contactConn :: Contact -> Maybe Connection contactConn Contact {activeConn} = activeConn @@ -356,7 +371,8 @@ data GroupInfo = GroupInfo createdAt :: UTCTime, updatedAt :: UTCTime, chatTs :: Maybe UTCTime, - userMemberProfileSentAt :: Maybe UTCTime + userMemberProfileSentAt :: Maybe UTCTime, + customData :: Maybe CustomData } deriving (Eq, Show) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 50dc151aa4..65a6626308 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -183,8 +183,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe CRUnknownMemberBlocked u g byM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember byM <> " blocked an unknown member, creating unknown member record " <> ttyMember um] CRUnknownMemberAnnounced u g _ um m -> ttyUser u [ttyGroup' g <> ": unknown member " <> ttyMember um <> " updated to " <> ttyMember m] CRGroupDeletedUser u g -> ttyUser u [ttyGroup' g <> ": you deleted the group"] - CRRcvFileDescrReady _ _ -> [] - CRRcvFileDescrNotReady _ _ -> [] + CRRcvFileDescrReady _ _ _ _ -> [] CRRcvFileProgressXFTP {} -> [] CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft @@ -391,6 +390,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)] CRAppSettings as -> ["app settings: " <> plain (LB.unpack $ J.encode as)] CRTimedAction _ _ -> [] + CRCustomChatResponse u r -> ttyUser' u $ [plain r] where ttyUser :: User -> [StyledString] -> [StyledString] ttyUser user@User {showNtfs, activeUser} ss @@ -1167,7 +1167,7 @@ viewNetworkConfig NetworkConfig {socksProxy, tcpTimeout} = ] viewContactInfo :: Contact -> Maybe ConnectionStats -> Maybe Profile -> [StyledString] -viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink}, activeConn} stats incognitoProfile = +viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink}, activeConn, customData} stats incognitoProfile = ["contact ID: " <> sShow contactId] <> maybe [] viewConnectionStats stats <> maybe [] (\l -> ["contact address: " <> (plain . strEncode) (simplexChatContact l)]) contactLink @@ -1179,12 +1179,17 @@ viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, conta <> [viewConnectionVerified (contactSecurityCode ct)] <> ["quantum resistant end-to-end encryption" | contactPQEnabled ct == CR.PQEncOn] <> maybe [] (\ac -> [viewPeerChatVRange (peerChatVRange ac)]) activeConn + <> viewCustomData customData viewGroupInfo :: GroupInfo -> GroupSummary -> [StyledString] -viewGroupInfo GroupInfo {groupId} s = +viewGroupInfo GroupInfo {groupId, customData} s = [ "group ID: " <> sShow groupId, "current members: " <> sShow (currentMembers s) ] + <> viewCustomData customData + +viewCustomData :: Maybe CustomData -> [StyledString] +viewCustomData = maybe [] (\(CustomData v) -> ["custom data: " <> plain (LB.toStrict . J.encode $ J.Object v)]) viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> [StyledString] viewGroupMemberInfo GroupInfo {groupId} m@GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias, contactLink}, activeConn} stats =