From 67461d6971f278ea7404175af288a98e321a8ba4 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 20 Oct 2025 08:12:45 +0000 Subject: [PATCH] core: manage chat relays initial (#6369) --- bots/api/TYPES.md | 6 + cabal.project | 2 +- .../types/typescript/src/types.ts | 9 ++ scripts/nix/sha256map.nix | 2 +- simplex-chat.cabal | 2 + src/Simplex/Chat.hs | 15 +- src/Simplex/Chat/Controller.hs | 3 +- src/Simplex/Chat/Core.hs | 2 +- src/Simplex/Chat/Library/Commands.hs | 58 ++++--- src/Simplex/Chat/Operators.hs | 146 +++++++++++++++--- src/Simplex/Chat/Operators/Presets.hs | 9 ++ src/Simplex/Chat/Store/Connections.hs | 4 +- src/Simplex/Chat/Store/Groups.hs | 29 ++-- src/Simplex/Chat/Store/Messages.hs | 8 +- src/Simplex/Chat/Store/Postgres/Migrations.hs | 4 +- .../Migrations/M20251016_chat_relays.hs | 46 ++++++ src/Simplex/Chat/Store/Profiles.hs | 80 ++++++++-- src/Simplex/Chat/Store/SQLite/Migrations.hs | 4 +- .../Migrations/M20251016_chat_relays.hs | 43 ++++++ .../Store/SQLite/Migrations/chat_schema.sql | 19 ++- src/Simplex/Chat/Store/Shared.hs | 17 +- src/Simplex/Chat/Terminal.hs | 6 +- src/Simplex/Chat/Types.hs | 13 +- src/Simplex/Chat/View.hs | 21 ++- tests/ChatClient.hs | 2 +- tests/JSONFixtures.hs | 6 +- tests/MobileTests.hs | 2 +- tests/OperatorTests.hs | 75 +++++++-- 28 files changed, 508 insertions(+), 125 deletions(-) create mode 100644 src/Simplex/Chat/Store/Postgres/Migrations/M20251016_chat_relays.hs create mode 100644 src/Simplex/Chat/Store/SQLite/Migrations/M20251016_chat_relays.hs diff --git a/bots/api/TYPES.md b/bots/api/TYPES.md index 923fab14c2..0c173df77c 100644 --- a/bots/api/TYPES.md +++ b/bots/api/TYPES.md @@ -958,6 +958,9 @@ UserExists: - type: "userExists" - contactName: string +ChatRelayExists: +- type: "chatRelayExists" + DifferentActiveUser: - type: "differentActiveUser" - commandUserId: int64 @@ -2215,6 +2218,7 @@ Known: - createdAt: UTCTime - updatedAt: UTCTime - supportChat: [GroupSupportChat](#groupsupportchat)? +- isChatRelay: bool --- @@ -2664,6 +2668,7 @@ SubscribeError: **Record type**: - profile: [Profile](#profile)? - pastTimestamp: bool +- userChatRelay: bool --- @@ -3715,6 +3720,7 @@ Handshake: - autoAcceptMemberContacts: bool - userMemberProfileUpdatedAt: UTCTime? - uiThemes: [UIThemeEntityOverrides](#uithemeentityoverrides)? +- userChatRelay: bool --- diff --git a/cabal.project b/cabal.project index eeadf7c6fd..a6b9414ca3 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 1329fc726ffb2e773935ad10f024a137dd887867 + tag: 0fc19708bd63dc23ebbf7331c9392a0783750591 source-repository-package type: git diff --git a/packages/simplex-chat-client/types/typescript/src/types.ts b/packages/simplex-chat-client/types/typescript/src/types.ts index b8095affdf..993ca789b3 100644 --- a/packages/simplex-chat-client/types/typescript/src/types.ts +++ b/packages/simplex-chat-client/types/typescript/src/types.ts @@ -969,6 +969,7 @@ export type ChatErrorType = | ChatErrorType.UserUnknown | ChatErrorType.ActiveUserExists | ChatErrorType.UserExists + | ChatErrorType.ChatRelayExists | ChatErrorType.DifferentActiveUser | ChatErrorType.CantDeleteActiveUser | ChatErrorType.CantDeleteLastUser @@ -1045,6 +1046,7 @@ export namespace ChatErrorType { | "userUnknown" | "activeUserExists" | "userExists" + | "chatRelayExists" | "differentActiveUser" | "cantDeleteActiveUser" | "cantDeleteLastUser" @@ -1148,6 +1150,10 @@ export namespace ChatErrorType { contactName: string } + export interface ChatRelayExists extends Interface { + type: "chatRelayExists" + } + export interface DifferentActiveUser extends Interface { type: "differentActiveUser" commandUserId: number // int64 @@ -2504,6 +2510,7 @@ export interface GroupMember { createdAt: string // ISO-8601 timestamp updatedAt: string // ISO-8601 timestamp supportChat?: GroupSupportChat + isChatRelay: boolean } export interface GroupMemberAdmission { @@ -2952,6 +2959,7 @@ export namespace NetworkError { export interface NewUser { profile?: Profile pastTimestamp: boolean + userChatRelay: boolean } export interface NoteFolder { @@ -4394,6 +4402,7 @@ export interface User { autoAcceptMemberContacts: boolean userMemberProfileUpdatedAt?: string // ISO-8601 timestamp uiThemes?: UIThemeEntityOverrides + userChatRelay: boolean } export interface UserContact { diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 1e3eda8f2b..fc0552319d 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."1329fc726ffb2e773935ad10f024a137dd887867" = "0wlpwr464i8dif5a94mfx31y3fm44gkc3h357dx8l1ii9q3sy05i"; + "https://github.com/simplex-chat/simplexmq.git"."0fc19708bd63dc23ebbf7331c9392a0783750591" = "02h5g5cjskmvvkqqd60dc5am2zz6ic7d0sjsiy83vfc750qnvd03"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/simplex-chat.cabal b/simplex-chat.cabal index e8f43f5f07..53b5f8689e 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -120,6 +120,7 @@ library Simplex.Chat.Store.Postgres.Migrations.M20250919_group_summary Simplex.Chat.Store.Postgres.Migrations.M20250922_remove_unused_connections Simplex.Chat.Store.Postgres.Migrations.M20251007_connections_sync + Simplex.Chat.Store.Postgres.Migrations.M20251016_chat_relays else exposed-modules: Simplex.Chat.Archive @@ -264,6 +265,7 @@ library Simplex.Chat.Store.SQLite.Migrations.M20250919_group_summary Simplex.Chat.Store.SQLite.Migrations.M20250922_remove_unused_connections Simplex.Chat.Store.SQLite.Migrations.M20251007_connections_sync + Simplex.Chat.Store.SQLite.Migrations.M20251016_chat_relays other-modules: Paths_simplex_chat hs-source-dirs: diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 9b711c2b50..8d70bd3bdd 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -73,14 +73,18 @@ defaultChatConfig = smp = simplexChatSMPServers, useSMP = 4, xftp = map (presetServer True) $ L.toList defaultXFTPServers, - useXFTP = 3 + useXFTP = 3, + chatRelays = simplexChatRelays, + useChatRelays = 2 }, PresetOperator { operator = Just operatorFlux, smp = fluxSMPServers, useSMP = 3, xftp = fluxXFTPServers, - useXFTP = 3 + useXFTP = 3, + chatRelays = [], + useChatRelays = 0 } ], ntf = _defaultNtfServers, @@ -239,7 +243,9 @@ newChatController smp = map newUserServer smpSrvs, useSMP = 0, xftp = map newUserServer xftpSrvs, - useXFTP = 0 + useXFTP = 0, + chatRelays = [], + useChatRelays = 0 } randomServerCfgs :: UserProtocol p => String -> SProtocolType p -> [(Text, ServerOperator)] -> [PresetOperator] -> IO (NonEmpty (ServerCfg p)) randomServerCfgs name p opDomains rndSrvs = @@ -260,7 +266,8 @@ newChatController getServers ops opDomains user' = do smpSrvs <- getProtocolServers db SPSMP user' xftpSrvs <- getProtocolServers db SPXFTP user' - uss <- groupByOperator' (ops, smpSrvs, xftpSrvs) + chatRelays <- getChatRelays db user' + uss <- groupByOperator' (ops, smpSrvs, xftpSrvs, chatRelays) ts <- getCurrentTime uss' <- mapM (setUserServers' db user' ts . updatedUserServers) uss let auId = aUserId user' diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 8003f66324..ad824d20f6 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -643,7 +643,7 @@ data ChatResponse | CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure} | CRServerOperatorConditions {conditions :: ServerOperatorConditions} | CRUserServers {user :: User, userServers :: [UserOperatorServers]} - | CRUserServersValidation {user :: User, serverErrors :: [UserServersError]} + | CRUserServersValidation {user :: User, serverErrors :: [UserServersError], serverWarnings :: [UserServersWarning]} | CRUsageConditions {usageConditions :: UsageConditions, conditionsText :: Text, acceptedConditions :: Maybe UsageConditions} | CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64} | CRNetworkConfig {networkConfig :: NetworkConfig} @@ -1250,6 +1250,7 @@ data ChatErrorType | CEUserUnknown | CEActiveUserExists -- TODO delete | CEUserExists {contactName :: ContactName} + | CEChatRelayExists | CEDifferentActiveUser {commandUserId :: UserId, activeUserId :: UserId} | CECantDeleteActiveUser {userId :: UserId} | CECantDeleteLastUser {userId :: UserId} diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index 131b420bd9..f9bf76e5b3 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -118,7 +118,7 @@ createActiveUser cc = \case createUser loop $ mkProfile displayName mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing} createUser onError p = - execChatCommand' (CreateActiveUser NewUser {profile = Just p, pastTimestamp = False}) 0 `runReaderT` cc >>= \case + execChatCommand' (CreateActiveUser NewUser {profile = Just p, pastTimestamp = False, userChatRelay = False}) 0 `runReaderT` cc >>= \case Right (CRActiveUser user) -> pure user r -> printResponseEvent (Nothing, Nothing) (config cc) r >> onError diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 67953897cf..d6688a939c 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -327,19 +327,20 @@ parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace processChatCommand :: VersionRangeChat -> NetworkRequestMode -> ChatCommand -> CM ChatResponse processChatCommand vr nm = \case ShowActiveUser -> withUser' $ pure . CRActiveUser - CreateActiveUser NewUser {profile, pastTimestamp} -> do + CreateActiveUser NewUser {profile, pastTimestamp, userChatRelay} -> do forM_ profile $ \Profile {displayName} -> checkValidName displayName p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile u <- asks currentUser users <- withFastStore' getUsers - forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash} -> + forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash, userChatRelay = userChatRelay'} -> do when (n == displayName) . throwChatError $ if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""} + when (userChatRelay && isTrue userChatRelay') $ throwChatError CEChatRelayExists (uss, (smp', xftp')) <- chooseServers =<< readTVarIO u auId <- withAgent $ \a -> createUser a smp' xftp' ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure user <- withFastStore $ \db -> do - user <- createUserRecordAt db (AgentUserId auId) p True ts + user <- createUserRecordAt db (AgentUserId auId) p userChatRelay True ts mapM_ (setUserServers db user ts) uss createPresetContactCards db user `catchAllErrors` \_ -> pure () createNoteFolder db user @@ -365,9 +366,16 @@ processChatCommand vr nm = \case let RandomAgentServers {smpServers = smp', xftpServers = xftp'} = as pure (uss, (smp', xftp')) copyServers :: UserOperatorServers -> UpdatedUserOperatorServers - copyServers UserOperatorServers {operator, smpServers, xftpServers} = - let new srv = AUS SDBNew srv {serverId = DBNewEntity} - in UpdatedUserOperatorServers {operator, smpServers = map new smpServers, xftpServers = map new xftpServers} + copyServers UserOperatorServers {operator, smpServers, xftpServers, chatRelays} = + let newSrv srv = AUS SDBNew srv {serverId = DBNewEntity} + newCRelay chatRelay = AUCR SDBNew chatRelay {chatRelayId = DBNewEntity} + in + UpdatedUserOperatorServers { + operator, + smpServers = map newSrv smpServers, + xftpServers = map newSrv xftpServers, + chatRelays = map newCRelay chatRelays + } coupleDaysAgo t = (`addUTCTime` t) . fromInteger . negate . (+ (2 * day)) <$> randomRIO (0, day) day = 86400 ListUsers -> CRUsersList <$> withFastStore' getUsersInfo @@ -1472,7 +1480,8 @@ processChatCommand vr nm = \case getServers db as ops opDomains user = do smpSrvs <- getProtocolServers db SPSMP user xftpSrvs <- getProtocolServers db SPXFTP user - uss <- groupByOperator (ops, smpSrvs, xftpSrvs) + chatRelays <- getChatRelays db user + uss <- groupByOperator (ops, smpSrvs, xftpSrvs, chatRelays) pure $ (aUserId user,) $ useServers as opDomains uss SetServerOperators operatorsRoles -> do ops <- serverOperators <$> withFastStore getServerOperators @@ -1487,8 +1496,9 @@ processChatCommand vr nm = \case APIGetUserServers userId -> withUserId userId $ \user -> withFastStore $ \db -> do CRUserServers user <$> (liftIO . groupByOperator =<< getUserServers db user) APISetUserServers userId userServers -> withUserId userId $ \user -> do - errors <- validateAllUsersServers userId $ L.toList userServers + (errors, warnings) <- validateAllUsersServers userId $ L.toList userServers unless (null errors) $ throwCmdError $ "user servers validation error(s): " <> show errors + unless (null warnings) $ logWarn $ "user servers validation warning(s): " <> tshow warnings uss <- withFastStore $ \db -> do ts <- liftIO getCurrentTime mapM (setUserServers db user ts) userServers @@ -1501,7 +1511,7 @@ processChatCommand vr nm = \case setProtocolServers a auId xftp' ok_ APIValidateServers userId userServers -> withUserId userId $ \user -> - CRUserServersValidation user <$> validateAllUsersServers userId userServers + uncurry (CRUserServersValidation user) <$> validateAllUsersServers userId userServers APIGetUsageConditions -> do (usageConditions, acceptedConditions) <- withFastStore $ \db -> do usageConditions <- getCurrentUsageConditions db @@ -3431,7 +3441,7 @@ processChatCommand vr nm = \case withServerProtocol p action = case userProtocol p of Just Dict -> action _ -> throwChatError $ CEServerProtocol $ AProtocolType p - validateAllUsersServers :: UserServersClass u => Int64 -> [u] -> CM [UserServersError] + validateAllUsersServers :: UserServersClass u => Int64 -> [u] -> CM ([UserServersError], [UserServersWarning]) validateAllUsersServers currUserId userServers = withFastStore $ \db -> do users' <- filter (\User {userId} -> userId /= currUserId) <$> liftIO (getUsers db) others <- mapM (getUserOperatorServers db) users' @@ -4031,18 +4041,21 @@ data ConnectViaContactResult = CVRConnectedContact Contact | CVRSentInvitation Connection (Maybe Profile) -protocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -protocolServers p (operators, smpServers, xftpServers) = case p of - SPSMP -> (operators, smpServers, []) - SPXFTP -> (operators, [], xftpServers) +-- TODO [chat relays] used for CLI specific APIs (same for `updatedServers` below) - add similar APIs for chat relays? +protocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay]) +protocolServers p (operators, smpServers, xftpServers, _chatRelays) = case p of + SPSMP -> (operators, smpServers, [], []) + SPXFTP -> (operators, [], xftpServers, []) -- disable preset and replace custom servers (groupByOperator always adds custom) updatedServers :: forall p. UserProtocol p => SProtocolType p -> [AUserServer p] -> UserOperatorServers -> UpdatedUserOperatorServers -updatedServers p' srvs UserOperatorServers {operator, smpServers, xftpServers} = case p' of - SPSMP -> u (updateSrvs smpServers, map (AUS SDBStored) xftpServers) - SPXFTP -> u (map (AUS SDBStored) smpServers, updateSrvs xftpServers) +updatedServers p' srvs UserOperatorServers {operator, smpServers, xftpServers, chatRelays} = case p' of + SPSMP -> u (updateSrvs smpServers, map (AUS SDBStored) xftpServers, map (AUCR SDBStored) chatRelays) + SPXFTP -> u (map (AUS SDBStored) smpServers, updateSrvs xftpServers, map (AUCR SDBStored) chatRelays) where - u = uncurry $ UpdatedUserOperatorServers operator + u = uncurry3 $ UpdatedUserOperatorServers operator + uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) + uncurry3 f ~(a,b,c) = f a b c updateSrvs :: [UserServer p] -> [AUserServer p] updateSrvs pSrvs = map disableSrv pSrvs <> maybe srvs (const []) operator disableSrv srv@UserServer {preset} = @@ -4282,7 +4295,8 @@ chatCommandP = "/block #" *> (SetShowMemberMessages <$> displayNameP <* A.space <*> (char_ '@' *> displayNameP) <*> pure False), "/unblock #" *> (SetShowMemberMessages <$> displayNameP <* A.space <*> (char_ '@' *> displayNameP) <*> pure True), "/_create user " *> (CreateActiveUser <$> jsonP), - "/create user " *> (CreateActiveUser <$> newUserP), + "/create user " *> (CreateActiveUser <$> newUserP False), + "/create chat relay user " *> (CreateActiveUser <$> newUserP True), "/create bot " *> (CreateActiveUser <$> newBotUserP), "/users" $> ListUsers, "/_user " *> (APISetActiveUser <$> A.decimal <*> optional (A.space *> jsonP)), @@ -4731,10 +4745,10 @@ chatCommandP = k : ws -> pure (k, if null ws then Nothing else Just $ T.unwords ws) pure CBCCommand {label, keyword, params} quoted = A.char '\'' *> A.takeTill (== '\'') <* A.char '\'' - newUserP = do + newUserP userChatRelay = do (cName, shortDescr) <- profileNameDescr let profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing} - pure NewUser {profile, pastTimestamp = False} + pure NewUser {profile, pastTimestamp = False, userChatRelay} newBotUserP = do files_ <- optional $ "files=" *> onOffP <* A.space (cName, shortDescr) <- profileNameDescr @@ -4742,7 +4756,7 @@ chatCommandP = Just True -> Nothing _ -> Just (emptyChatPrefs :: Preferences) {files = Just FilesPreference {allow = FANo}} profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences} - pure NewUser {profile, pastTimestamp = False} + pure NewUser {profile, pastTimestamp = False, userChatRelay = False} jsonP :: J.FromJSON a => Parser a jsonP = J.eitherDecodeStrict' <$?> A.takeByteString groupProfile = do diff --git a/src/Simplex/Chat/Operators.hs b/src/Simplex/Chat/Operators.hs index 24baa37e4e..4a8ac65d5e 100644 --- a/src/Simplex/Chat/Operators.hs +++ b/src/Simplex/Chat/Operators.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -45,8 +46,9 @@ import Data.Time (addUTCTime) import Data.Time.Clock (UTCTime, nominalDay) import Language.Haskell.TH.Syntax (lift) import Simplex.Chat.Operators.Conditions -import Simplex.Chat.Types (User) +import Simplex.Chat.Types (ConnLinkContact, User) import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles) +import Simplex.Messaging.Agent.Protocol (sameConnLinkContact) import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_) import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Encoding.String @@ -180,14 +182,16 @@ conditionsAccepted ServerOperator {conditionsAcceptance} = case conditionsAccept data UserOperatorServers = UserOperatorServers { operator :: Maybe ServerOperator, smpServers :: [UserServer 'PSMP], - xftpServers :: [UserServer 'PXFTP] + xftpServers :: [UserServer 'PXFTP], + chatRelays :: [UserChatRelay] } deriving (Show) data UpdatedUserOperatorServers = UpdatedUserOperatorServers { operator :: Maybe ServerOperator, smpServers :: [AUserServer 'PSMP], - xftpServers :: [AUserServer 'PXFTP] + xftpServers :: [AUserServer 'PXFTP], + chatRelays :: [AUserChatRelay] } deriving (Show) @@ -196,25 +200,34 @@ data ValidatedProtoServer p = ValidatedProtoServer {unVPS :: Either Text (ProtoS class UserServersClass u where type AServer u = (s :: ProtocolType -> Type) | s -> u + type AChatRelay u = (s :: Type) | s -> u operator' :: u -> Maybe ServerOperator aUserServer' :: AServer u p -> AUserServer p servers' :: UserProtocol p => SProtocolType p -> u -> [AServer u p] + chatRelays' :: u -> [AChatRelay u] + aUserChatRelay' :: AChatRelay u -> AUserChatRelay instance UserServersClass UserOperatorServers where type AServer UserOperatorServers = UserServer' 'DBStored + type AChatRelay UserOperatorServers = UserChatRelay' 'DBStored operator' UserOperatorServers {operator} = operator aUserServer' = AUS SDBStored servers' p UserOperatorServers {smpServers, xftpServers} = case p of SPSMP -> smpServers SPXFTP -> xftpServers + chatRelays' UserOperatorServers {chatRelays} = chatRelays + aUserChatRelay' = AUCR SDBStored instance UserServersClass UpdatedUserOperatorServers where type AServer UpdatedUserOperatorServers = AUserServer + type AChatRelay UpdatedUserOperatorServers = AUserChatRelay operator' UpdatedUserOperatorServers {operator} = operator aUserServer' = id servers' p UpdatedUserOperatorServers {smpServers, xftpServers} = case p of SPSMP -> smpServers SPXFTP -> xftpServers + chatRelays' UpdatedUserOperatorServers {chatRelays} = chatRelays + aUserChatRelay' = id type UserServer p = UserServer' 'DBStored p @@ -238,12 +251,34 @@ presetServerAddress :: UserServer' s p -> ProtocolServer p presetServerAddress UserServer {server = ProtoServerWithAuth srv _} = srv {-# INLINE presetServerAddress #-} +type UserChatRelay = UserChatRelay' 'DBStored + +type NewUserChatRelay = UserChatRelay' 'DBNew + +data AUserChatRelay = forall s. AUCR (SDBStored s) (UserChatRelay' s) + +deriving instance Show AUserChatRelay + +data UserChatRelay' s = UserChatRelay + { chatRelayId :: DBEntityId' s, + address :: ConnLinkContact, + name :: Text, + domains :: [Text], + preset :: Bool, + tested :: Maybe Bool, + enabled :: Bool, + deleted :: Bool + } + deriving (Show) + data PresetOperator = PresetOperator { operator :: Maybe NewServerOperator, smp :: [NewUserServer 'PSMP], useSMP :: Int, xftp :: [NewUserServer 'PXFTP], - useXFTP :: Int + useXFTP :: Int, + chatRelays :: [NewUserChatRelay], + useChatRelays :: Int } deriving (Show) @@ -262,17 +297,32 @@ operatorServersToUse p PresetOperator {useSMP, useXFTP} = case p of presetServer' :: Bool -> ProtocolServer p -> NewUserServer p presetServer' enabled = presetServer enabled . (`ProtoServerWithAuth` Nothing) +{-# INLINE presetServer' #-} presetServer :: Bool -> ProtoServerWithAuth p -> NewUserServer p presetServer = newUserServer_ True +{-# INLINE presetServer #-} newUserServer :: ProtoServerWithAuth p -> NewUserServer p newUserServer = newUserServer_ False True +{-# INLINE newUserServer #-} newUserServer_ :: Bool -> Bool -> ProtoServerWithAuth p -> NewUserServer p newUserServer_ preset enabled server = UserServer {serverId = DBNewEntity, server, preset, tested = Nothing, enabled, deleted = False} +presetChatRelay :: Bool -> Text -> [Text] -> ConnLinkContact -> NewUserChatRelay +presetChatRelay = newChatRelay_ True +{-# INLINE presetChatRelay #-} + +newChatRelay :: Text -> [Text] -> ConnLinkContact -> NewUserChatRelay +newChatRelay = newChatRelay_ False True +{-# INLINE newChatRelay #-} + +newChatRelay_ :: Bool -> Bool -> Text -> [Text] -> ConnLinkContact -> NewUserChatRelay +newChatRelay_ preset enabled name domains !address = + UserChatRelay {chatRelayId = DBNewEntity, address, name, domains, preset, tested = Nothing, enabled, deleted = False} + -- This function should be used inside DB transaction to update conditions in the database -- it evaluates to (current conditions, and conditions to add) usageConditionsToAdd :: Bool -> UTCTime -> [UsageConditions] -> (UsageConditions, [UsageConditions]) @@ -300,8 +350,8 @@ usageConditionsToAdd' prevCommit sourceCommit newUser createdAt = \case presetUserServers :: [(Maybe PresetOperator, Maybe ServerOperator)] -> [UpdatedUserOperatorServers] presetUserServers = mapMaybe $ \(presetOp_, op) -> mkUS op <$> presetOp_ where - mkUS op PresetOperator {smp, xftp} = - UpdatedUserOperatorServers op (map (AUS SDBNew) smp) (map (AUS SDBNew) xftp) + mkUS op PresetOperator {smp, xftp, chatRelays} = + UpdatedUserOperatorServers op (map (AUS SDBNew) smp) (map (AUS SDBNew) xftp) (map (AUCR SDBNew) chatRelays) -- This function should be used inside DB transaction to update operators. -- It allows to add/remove/update preset operators in the database preserving enabled and roles settings, @@ -322,7 +372,7 @@ updatedServerOperators presetOps storedOps = -- This function should be used inside DB transaction to update servers. updatedUserServers :: (Maybe PresetOperator, UserOperatorServers) -> UpdatedUserOperatorServers updatedUserServers (presetOp_, UserOperatorServers {operator, smpServers, xftpServers}) = - UpdatedUserOperatorServers {operator, smpServers = smp', xftpServers = xftp'} + UpdatedUserOperatorServers {operator, smpServers = smp', xftpServers = xftp', chatRelays = []} where stored = map (AUS SDBStored) (smp', xftp') = case presetOp_ of @@ -335,7 +385,7 @@ updatedUserServers (presetOp_, UserOperatorServers {operator, smpServers, xftpSe storedSrvs :: Map (ProtoServerWithAuth p) (UserServer p) storedSrvs = foldl' (\ss srv@UserServer {server} -> M.insert server srv ss) M.empty srvs customServer :: UserServer p -> Bool - customServer srv = not (preset srv) && all (`S.notMember` presetHosts) (srvHost srv) + customServer srv@UserServer {preset} = not preset && all (`S.notMember` presetHosts) (srvHost srv) presetSrvs :: [NewUserServer p] presetSrvs = pServers p presetOp presetHosts :: Set TransportHost @@ -378,46 +428,58 @@ instance Box ((,) (Maybe a)) where box = (Nothing,) unbox = snd -groupByOperator :: ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> IO [UserOperatorServers] -groupByOperator (ops, smpSrvs, xftpSrvs) = map runIdentity <$> groupByOperator_ (map Identity ops, smpSrvs, xftpSrvs) +groupByOperator :: ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay]) -> IO [UserOperatorServers] +groupByOperator (ops, smpSrvs, xftpSrvs, chatRelays) = map runIdentity <$> groupByOperator_ (map Identity ops, smpSrvs, xftpSrvs, chatRelays) -- For the initial app start this function relies on tuple being Functor/Box -- to preserve the information about operator being DBNew or DBStored -groupByOperator' :: ([(Maybe PresetOperator, Maybe ServerOperator)], [UserServer 'PSMP], [UserServer 'PXFTP]) -> IO [(Maybe PresetOperator, UserOperatorServers)] +groupByOperator' :: ([(Maybe PresetOperator, Maybe ServerOperator)], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay]) -> IO [(Maybe PresetOperator, UserOperatorServers)] groupByOperator' = groupByOperator_ {-# INLINE groupByOperator' #-} -groupByOperator_ :: forall f. (Box f, Traversable f) => ([f (Maybe ServerOperator)], [UserServer 'PSMP], [UserServer 'PXFTP]) -> IO [f UserOperatorServers] -groupByOperator_ (ops, smpSrvs, xftpSrvs) = do +groupByOperator_ :: forall f. (Box f, Traversable f) => ([f (Maybe ServerOperator)], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay]) -> IO [f UserOperatorServers] +groupByOperator_ (ops, smpSrvs, xftpSrvs, cRelays) = do let ops' = mapMaybe sequence ops customOp_ = find (isNothing . unbox) ops ss <- mapM ((\op -> (serverDomains (unbox op),) <$> newIORef (mkUS . Just <$> op))) ops' custom <- newIORef $ maybe (box $ mkUS Nothing) (mkUS <$>) customOp_ mapM_ (addServer ss custom addSMP) (reverse smpSrvs) mapM_ (addServer ss custom addXFTP) (reverse xftpSrvs) + mapM_ (addChatRelay ss custom) cRelays opSrvs <- mapM (readIORef . snd) ss customSrvs <- readIORef custom pure $ opSrvs <> [customSrvs] where - mkUS op = UserOperatorServers op [] [] + mkUS op = UserOperatorServers op [] [] [] addServer :: [([Text], IORef (f UserOperatorServers))] -> IORef (f UserOperatorServers) -> (UserServer p -> UserOperatorServers -> UserOperatorServers) -> UserServer p -> IO () addServer ss custom add srv = let v = maybe custom snd $ find (\(ds, _) -> any (\d -> any (matchingHost d) (srvHost srv)) ds) ss in atomicModifyIORef'_ v (add srv <$>) addSMP srv s@UserOperatorServers {smpServers} = (s :: UserOperatorServers) {smpServers = srv : smpServers} addXFTP srv s@UserOperatorServers {xftpServers} = (s :: UserOperatorServers) {xftpServers = srv : xftpServers} + addChatRelay :: [([Text], IORef (f UserOperatorServers))] -> IORef (f UserOperatorServers) -> UserChatRelay -> IO () + addChatRelay ss custom chatRelay = + let v = maybe custom snd $ find (\(ds, _) -> any (`elem` domains chatRelay) ds) ss + in atomicModifyIORef'_ v (addCRelay <$>) + where + addCRelay s@UserOperatorServers {chatRelays} = (s :: UserOperatorServers) {chatRelays = chatRelay : chatRelays} data UserServersError = USENoServers {protocol :: AProtocolType, user :: Maybe User} | USEStorageMissing {protocol :: AProtocolType, user :: Maybe User} | USEProxyMissing {protocol :: AProtocolType, user :: Maybe User} | USEDuplicateServer {protocol :: AProtocolType, duplicateServer :: Text, duplicateHost :: TransportHost} + | USEDuplicateChatRelayName {duplicateChatRelay :: Text} + | USEDuplicateChatRelayAddress {duplicateChatRelay :: Text, duplicateAddress :: ConnLinkContact} deriving (Show) -validateUserServers :: UserServersClass u' => [u'] -> [(User, [UserOperatorServers])] -> [UserServersError] -validateUserServers curr others = currUserErrs <> concatMap otherUserErrs others +data UserServersWarning = USWNoChatRelays {user :: Maybe User} + deriving (Show) + +validateUserServers :: UserServersClass u' => [u'] -> [(User, [UserOperatorServers])] -> ([UserServersError], [UserServersWarning]) +validateUserServers curr others = (currUserErrs <> concatMap otherUserErrs others, currUserWarns <> concatMap otherUserWarns others) where - currUserErrs = noServersErrs SPSMP Nothing curr <> noServersErrs SPXFTP Nothing curr <> serverErrs SPSMP curr <> serverErrs SPXFTP curr + currUserErrs = noServersErrs SPSMP Nothing curr <> noServersErrs SPXFTP Nothing curr <> serverErrs SPSMP curr <> serverErrs SPXFTP curr <> chatRelayErrs curr otherUserErrs (user, uss) = noServersErrs SPSMP (Just user) uss <> noServersErrs SPXFTP (Just user) uss noServersErrs :: (UserServersClass u, ProtocolTypeI p, UserProtocol p) => SProtocolType p -> Maybe User -> [u] -> [UserServersError] noServersErrs p user uss @@ -426,7 +488,6 @@ validateUserServers curr others = currUserErrs <> concatMap otherUserErrs others where p' = AProtocolType p noServers cond = not $ any srvEnabled $ userServers p $ filter cond uss - opEnabled = maybe True (\ServerOperator {enabled} -> enabled) . operator' hasRole roleSel = maybe True (\op@ServerOperator {enabled} -> enabled && roleSel (operatorRoles p op)) . operator' srvEnabled (AUS _ UserServer {deleted, enabled}) = enabled && not deleted serverErrs :: (UserServersClass u, ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [u] -> [UserServersError] @@ -437,13 +498,42 @@ validateUserServers curr others = currUserErrs <> concatMap otherUserErrs others duplicateErr_ (AUS _ srv@UserServer {server}) = USEDuplicateServer p' (safeDecodeUtf8 $ strEncode server) <$> find (`S.member` duplicateHosts) (srvHost srv) - duplicateHosts = snd $ foldl' addHost (S.empty, S.empty) allHosts + duplicateHosts = snd $ foldl' addDuplicate (S.empty, S.empty) allHosts allHosts = concatMap (\(AUS _ srv) -> L.toList $ srvHost srv) srvs - addHost (hs, dups) h - | h `S.member` hs = (hs, S.insert h dups) - | otherwise = (S.insert h hs, dups) userServers :: (UserServersClass u, UserProtocol p) => SProtocolType p -> [u] -> [AUserServer p] userServers p = map aUserServer' . concatMap (servers' p) + chatRelayErrs :: UserServersClass u => [u] -> [UserServersError] + chatRelayErrs uss = concatMap duplicateErrs_ speers + where + speers = filter (\(AUCR _ UserChatRelay {deleted}) -> not deleted) $ userChatRelays uss + duplicateErrs_ (AUCR _ UserChatRelay {name, address}) = + [USEDuplicateChatRelayName name | name `elem` duplicateNames] + <> [USEDuplicateChatRelayAddress name address | address `elem` duplicateAddresses] + duplicateNames = snd $ foldl' addDuplicate (S.empty, S.empty) allNames + allNames = map (\(AUCR _ speer) -> name speer) speers + duplicateAddresses = snd $ foldl' addAddress ([], []) allAddresses + allAddresses = map (\(AUCR _ speer) -> address speer) speers + addAddress :: ([ConnLinkContact], [ConnLinkContact]) -> ConnLinkContact -> ([ConnLinkContact], [ConnLinkContact]) + addAddress (xs, dups) x + | any (sameConnLinkContact x) xs = (xs, x : dups) + | otherwise = (x : xs, dups) + currUserWarns = noChatRelaysWarns Nothing curr + otherUserWarns (user, uss) = noChatRelaysWarns (Just user) uss + noChatRelaysWarns :: UserServersClass u => Maybe User -> [u] -> [UserServersWarning] + noChatRelaysWarns user uss + | noChatRelays opEnabled = [USWNoChatRelays user] + | otherwise = [] + where + noChatRelays cond = not $ any speerEnabled $ userChatRelays $ filter cond uss + speerEnabled (AUCR _ UserChatRelay {deleted, enabled}) = enabled && not deleted + userChatRelays :: UserServersClass u => [u] -> [AUserChatRelay] + userChatRelays = map aUserChatRelay' . concatMap chatRelays' + opEnabled :: UserServersClass u => u -> Bool + opEnabled = maybe True (\ServerOperator {enabled} -> enabled) . operator' + addDuplicate :: Ord a => (Set a, Set a) -> a -> (Set a, Set a) + addDuplicate (xs, dups) x + | x `S.member` xs = (xs, S.insert x dups) + | otherwise = (S.insert x xs, dups) $(JQ.deriveJSON defaultJSON ''UsageConditions) @@ -470,9 +560,21 @@ instance (DBStoredI s, ProtocolTypeI p) => FromJSON (UserServer' s p) where instance ProtocolTypeI p => FromJSON (AUserServer p) where parseJSON v = (AUS SDBStored <$> parseJSON v) <|> (AUS SDBNew <$> parseJSON v) +instance ToJSON (UserChatRelay' s) where + toEncoding = $(JQ.mkToEncoding defaultJSON ''UserChatRelay') + toJSON = $(JQ.mkToJSON defaultJSON ''UserChatRelay') + +instance DBStoredI s => FromJSON (UserChatRelay' s) where + parseJSON = $(JQ.mkParseJSON defaultJSON ''UserChatRelay') + +instance FromJSON AUserChatRelay where + parseJSON v = (AUCR SDBStored <$> parseJSON v) <|> (AUCR SDBNew <$> parseJSON v) + $(JQ.deriveJSON defaultJSON ''UserOperatorServers) instance FromJSON UpdatedUserOperatorServers where parseJSON = $(JQ.mkParseJSON defaultJSON ''UpdatedUserOperatorServers) $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "USE") ''UserServersError) + +$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "USW") ''UserServersWarning) diff --git a/src/Simplex/Chat/Operators/Presets.hs b/src/Simplex/Chat/Operators/Presets.hs index d3d727ea05..d87cdbc18b 100644 --- a/src/Simplex/Chat/Operators/Presets.hs +++ b/src/Simplex/Chat/Operators/Presets.hs @@ -10,6 +10,7 @@ import qualified Data.List.NonEmpty as L import Simplex.Chat.Operators import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..), allRoles) import Simplex.Messaging.Agent.Store.Entity +import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol (ProtocolType (..), SMPServer) operatorSimpleXChat :: NewServerOperator @@ -87,6 +88,14 @@ disabledSimplexChatSMPServers = "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion" ] +-- TODO [chat relays] real chat relays +simplexChatRelays :: [NewUserChatRelay] +simplexChatRelays = + [ presetChatRelay True "chat_relay_1" ["simplex.im"] (either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp111.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D"), + presetChatRelay True "chat_relay_2" ["simplex.im"] (either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp222.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D"), + presetChatRelay True "chat_relay_3" ["simplex.im"] (either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp333.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D") + ] + fluxSMPServers :: [NewUserServer 'PSMP] fluxSMPServers = map (presetServer' True) (L.toList fluxSMPServers_) diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index 9467675272..2da8f183e7 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -143,13 +143,13 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do g.ui_themes, g.summary_current_members_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri, -- 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, + mu.member_status, mu.show_messages, mu.member_restriction, mu.is_chat_relay, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, -- GroupInfo {membership = GroupMember {memberProfile}} pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences, mu.created_at, mu.updated_at, mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts, -- from GroupMember - m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction, + m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction, m.is_chat_relay, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, m.created_at, m.updated_at, m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 00aa527603..ddeb320212 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -190,11 +190,11 @@ import Database.SQLite.Simple (Only (..), Query, (:.) (..)) import Database.SQLite.Simple.QQ (sql) #endif -type MaybeGroupMemberRow = (Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId) :. (Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe LocalAlias, Maybe Preferences) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime) +type MaybeGroupMemberRow = (Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus, Maybe BoolInt) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId) :. (Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe LocalAlias, Maybe Preferences) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime) toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember -toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId) :. (Just profileId, Just displayName, Just fullName, shortDescr, image, contactLink, peerType, Just localAlias, contactPreferences) :. (Just createdAt, Just updatedAt) :. (supportChatTs, Just supportChatUnread, Just supportChatUnanswered, Just supportChatMentions, supportChatLastMsgFromMemberTs)) = - Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. (profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, contactPreferences) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs)) +toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked', Just isChatRelay) :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId) :. (Just profileId, Just displayName, Just fullName, shortDescr, image, contactLink, peerType, Just localAlias, contactPreferences) :. (Just createdAt, Just updatedAt) :. (supportChatTs, Just supportChatUnread, Just supportChatUnanswered, Just supportChatMentions, supportChatLastMsgFromMemberTs)) = + Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked', isChatRelay) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. (profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, contactPreferences) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs)) toMaybeGroupMember _ _ = Nothing createGroupLink :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> ConnId -> CreatedLinkContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO GroupLink @@ -480,7 +480,8 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe memberChatVRange, createdAt, updatedAt = createdAt, - supportChat = Nothing + supportChat = Nothing, + isChatRelay = BoolDef False } where memberChatVRange@(VersionRange minV maxV) = vr @@ -1098,7 +1099,8 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, memberChatVRange = peerChatVRange, createdAt, updatedAt = createdAt, - supportChat = Nothing + supportChat = Nothing, + isChatRelay = BoolDef False } where insertMember_ = @@ -1415,7 +1417,8 @@ createNewGroupMember db user gInfo invitingMember memInfo@MemberInfo {profile} m memInvitedByGroupMemberId = Just $ groupMemberId' invitingMember, localDisplayName, memContactId = Nothing, - memProfileId + memProfileId, + isChatRelay = False } liftIO $ createNewMember_ db user gInfo newMember currentTs @@ -1443,7 +1446,8 @@ createNewMember_ memInvitedByGroupMemberId, localDisplayName, memContactId = memberContactId, - memProfileId = memberContactProfileId + memProfileId = memberContactProfileId, + isChatRelay } createdAt = do let invitedById = fromInvitedBy userContactId invitedBy @@ -1453,12 +1457,12 @@ createNewMember_ db [sql| INSERT INTO group_members - (group_id, member_id, member_role, member_category, member_status, member_restriction, invited_by, invited_by_group_member_id, + (group_id, member_id, member_role, member_category, member_status, member_restriction, is_chat_relay, invited_by, invited_by_group_member_id, user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at, peer_chat_min_version, peer_chat_max_version) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] - ( (groupId, memberId, memberRole, memberCategory, memberStatus, memRestriction, invitedById, memInvitedByGroupMemberId) + ( (groupId, memberId, memberRole, memberCategory, memberStatus, memRestriction, BI isChatRelay, invitedById, memInvitedByGroupMemberId) :. (userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt) :. (minV, maxV) ) @@ -1483,7 +1487,8 @@ createNewMember_ memberChatVRange, createdAt, updatedAt = createdAt, - supportChat = Nothing + supportChat = Nothing, + isChatRelay = BoolDef isChatRelay } checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId) @@ -1703,7 +1708,7 @@ createIntroReMember memRestriction = restriction <$> memRestrictions_ currentTs <- liftIO getCurrentTime (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs - let newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId} + let newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId, isChatRelay = False} liftIO $ do member <- createNewMember_ db user gInfo newMember currentTs conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId chatV mcvr memberContactId cLevel currentTs subMode diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 47aabd16ee..df5b800c65 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -675,7 +675,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe SELECT i.chat_item_id, -- GroupMember m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, - m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, + m.member_status, m.show_messages, m.member_restriction, m.is_chat_relay, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, m.created_at, m.updated_at, m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts @@ -2999,7 +2999,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do i.forwarded_by_group_member_id, i.show_group_as_sender, -- GroupMember m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, - m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, + m.member_status, m.show_messages, m.member_restriction, m.is_chat_relay, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, m.created_at, m.updated_at, m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, @@ -3007,13 +3007,13 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, -- quoted GroupMember rm.group_member_id, rm.group_id, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category, - rm.member_status, rm.show_messages, rm.member_restriction, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id, + rm.member_status, rm.show_messages, rm.member_restriction, rm.is_chat_relay, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id, rp.display_name, rp.full_name, rp.short_descr, rp.image, rp.contact_link, rp.chat_peer_type, rp.local_alias, rp.preferences, rm.created_at, rm.updated_at, rm.support_chat_ts, rm.support_chat_items_unread, rm.support_chat_items_member_attention, rm.support_chat_items_mentions, rm.support_chat_last_msg_from_member_ts, -- deleted by GroupMember dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category, - dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id, + dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.is_chat_relay, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id, dbp.display_name, dbp.full_name, dbp.short_descr, dbp.image, dbp.contact_link, dbp.chat_peer_type, dbp.local_alias, dbp.preferences, dbm.created_at, dbm.updated_at, dbm.support_chat_ts, dbm.support_chat_items_unread, dbm.support_chat_items_member_attention, dbm.support_chat_items_mentions, dbm.support_chat_last_msg_from_member_ts diff --git a/src/Simplex/Chat/Store/Postgres/Migrations.hs b/src/Simplex/Chat/Store/Postgres/Migrations.hs index c6c04b465b..917c80c7e2 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations.hs @@ -20,6 +20,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20250813_delivery_tasks import Simplex.Chat.Store.Postgres.Migrations.M20250919_group_summary import Simplex.Chat.Store.Postgres.Migrations.M20250922_remove_unused_connections import Simplex.Chat.Store.Postgres.Migrations.M20251007_connections_sync +import Simplex.Chat.Store.Postgres.Migrations.M20251016_chat_relays import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Text, Maybe Text)] @@ -39,7 +40,8 @@ schemaMigrations = ("20250813_delivery_tasks", m20250813_delivery_tasks, Just down_m20250813_delivery_tasks), ("20250919_group_summary", m20250919_group_summary, Just down_m20250919_group_summary), ("20250922_remove_unused_connections", m20250922_remove_unused_connections, Just down_m20250922_remove_unused_connections), - ("20251007_connections_sync", m20251007_connections_sync, Just down_m20251007_connections_sync) + ("20251007_connections_sync", m20251007_connections_sync, Just down_m20251007_connections_sync), + ("20251016_chat_relays", m20251016_chat_relays, Just down_m20251016_chat_relays) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20251016_chat_relays.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20251016_chat_relays.hs new file mode 100644 index 0000000000..aeaf75bda1 --- /dev/null +++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20251016_chat_relays.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.Postgres.Migrations.M20251016_chat_relays where + +import Data.Text (Text) +import qualified Data.Text as T +import Text.RawString.QQ (r) + +m20251016_chat_relays :: Text +m20251016_chat_relays = + T.pack + [r| +CREATE TABLE chat_relays( + chat_relay_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY, + address TEXT NOT NULL, + name TEXT NOT NULL, + domains TEXT NOT NULL, + preset SMALLINT NOT NULL DEFAULT 0, + tested SMALLINT, + enabled SMALLINT NOT NULL DEFAULT 1, + user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT NOT NULL DEFAULT (now()), + updated_at TEXT NOT NULL DEFAULT (now()), + UNIQUE(user_id, address), + UNIQUE(user_id, name) +); + +CREATE INDEX idx_chat_relays_user_id ON chat_relays(user_id); + +ALTER TABLE users ADD COLUMN is_user_chat_relay SMALLINT NOT NULL DEFAULT 0; + +ALTER TABLE group_members ADD COLUMN is_chat_relay SMALLINT NOT NULL DEFAULT 0; +|] + +down_m20251016_chat_relays :: Text +down_m20251016_chat_relays = + T.pack + [r| +ALTER TABLE group_members DROP COLUMN is_chat_relay; + +ALTER TABLE users DROP COLUMN is_user_chat_relay; + +DROP INDEX idx_chat_relays_user_id; + +DROP TABLE chat_relays; +|] diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index af46c14b83..097e38ab36 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -57,6 +57,7 @@ module Simplex.Chat.Store.Profiles getContactWithoutConnViaShortAddress, updateUserAddressSettings, getProtocolServers, + getChatRelays, insertProtocolServer, getUpdateServerOperators, getServerOperators, @@ -125,11 +126,11 @@ import Database.SQLite.Simple (Only (..), Query, (:.) (..)) import Database.SQLite.Simple.QQ (sql) #endif -createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User -createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime +createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> Bool -> ExceptT StoreError IO User +createUserRecord db auId p userChatRelay activeUser = createUserRecordAt db auId p userChatRelay activeUser =<< liftIO getCurrentTime -createUserRecordAt :: DB.Connection -> AgentUserId -> Profile -> Bool -> UTCTime -> ExceptT StoreError IO User -createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, shortDescr, image, peerType, preferences = userPreferences} activeUser currentTs = +createUserRecordAt :: DB.Connection -> AgentUserId -> Profile -> Bool -> Bool -> UTCTime -> ExceptT StoreError IO User +createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, shortDescr, image, peerType, preferences = userPreferences} userChatRelay activeUser currentTs = checkConstraint SEDuplicateName . liftIO $ do when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0" let showNtfs = True @@ -157,7 +158,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, shortDe (profileId, displayName, userId, BI True, currentTs, currentTs, currentTs) contactId <- insertedRowId db DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId) - pure $ toUser $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, Nothing, Nothing, Nothing, Nothing) + pure $ toUser $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, Nothing, Nothing, Nothing, Nothing, BI userChatRelay) -- TODO [mentions] getUsersInfo :: DB.Connection -> IO [UserInfo] @@ -610,6 +611,49 @@ serverColumns p (ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_) auth = safeDecodeUtf8 . unBasicAuth <$> auth_ in (protocol, host, port, keyHash, auth) +getChatRelays :: DB.Connection -> User -> IO [UserChatRelay] +getChatRelays db User {userId} = + map toChatRelay + <$> DB.query + db + [sql| + SELECT chat_relay_id, address, name, domains, preset, tested, enabled + FROM chat_relays + WHERE user_id = ? + |] + (Only userId) + where + toChatRelay :: (DBEntityId, ConnLinkContact, Text, Text, BoolInt, Maybe BoolInt, BoolInt) -> UserChatRelay + toChatRelay (chatRelayId, address, name, domains, BI preset, tested, BI enabled) = + UserChatRelay {chatRelayId, address, name, domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted = False} + +insertChatRelay :: DB.Connection -> User -> UTCTime -> NewUserChatRelay -> IO UserChatRelay +insertChatRelay db User {userId} ts speer@UserChatRelay {address, name, domains, preset, tested, enabled} = do + crId <- + fromOnly . head + <$> DB.query + db + [sql| + INSERT INTO chat_relays + (address, name, domains, preset, tested, enabled, user_id, created_at, updated_at) + VALUES (?,?,?,?,?,?,?,?,?) + RETURNING chat_relay_id + |] + (address, name, T.intercalate "," domains, BI preset, BI <$> tested, BI enabled, userId, ts, ts) + pure speer {chatRelayId = DBEntityId crId} + +updateChatRelay :: DB.Connection -> UTCTime -> UserChatRelay -> IO () +updateChatRelay db ts UserChatRelay {chatRelayId, address, name, domains, preset, tested, enabled} = + DB.execute + db + [sql| + UPDATE chat_relays + SET address = ?, name = ?, domains = ?, + preset = ?, tested = ?, enabled = ?, updated_at = ? + WHERE chat_relay_id = ? + |] + (address, name, T.intercalate "," domains, BI preset, BI <$> tested, BI enabled, ts, chatRelayId) + getServerOperators :: DB.Connection -> ExceptT StoreError IO ServerOperatorConditions getServerOperators db = do currentConditions <- getCurrentUsageConditions db @@ -621,12 +665,13 @@ getServerOperators db = do let conditionsAction = usageConditionsAction ops currentConditions now pure ServerOperatorConditions {serverOperators = ops, currentConditions, conditionsAction} -getUserServers :: DB.Connection -> User -> ExceptT StoreError IO ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) +getUserServers :: DB.Connection -> User -> ExceptT StoreError IO ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay]) getUserServers db user = - (,,) + (,,,) <$> (map Just . serverOperators <$> getServerOperators db) <*> liftIO (getProtocolServers db SPSMP user) <*> liftIO (getProtocolServers db SPXFTP user) + <*> liftIO (getChatRelays db user) setServerOperators :: DB.Connection -> NonEmpty ServerOperator -> IO () setServerOperators db ops = do @@ -839,20 +884,29 @@ setUserServers :: DB.Connection -> User -> UTCTime -> UpdatedUserOperatorServers setUserServers db user ts = checkConstraint SEUniqueID . liftIO . setUserServers' db user ts setUserServers' :: DB.Connection -> User -> UTCTime -> UpdatedUserOperatorServers -> IO UserOperatorServers -setUserServers' db user@User {userId} ts UpdatedUserOperatorServers {operator, smpServers, xftpServers} = do +setUserServers' db user@User {userId} ts UpdatedUserOperatorServers {operator, smpServers, xftpServers, chatRelays} = do mapM_ (updateServerOperator db ts) operator - smpSrvs' <- catMaybes <$> mapM (upsertOrDelete SPSMP) smpServers - xftpSrvs' <- catMaybes <$> mapM (upsertOrDelete SPXFTP) xftpServers - pure UserOperatorServers {operator, smpServers = smpSrvs', xftpServers = xftpSrvs'} + smpSrvs' <- catMaybes <$> mapM (upsertOrDeleteSrv SPSMP) smpServers + xftpSrvs' <- catMaybes <$> mapM (upsertOrDeleteSrv SPXFTP) xftpServers + cRelays' <- catMaybes <$> mapM upsertOrDeleteCRelay chatRelays + pure UserOperatorServers {operator, smpServers = smpSrvs', xftpServers = xftpSrvs', chatRelays = cRelays'} where - upsertOrDelete :: ProtocolTypeI p => SProtocolType p -> AUserServer p -> IO (Maybe (UserServer p)) - upsertOrDelete p (AUS _ s@UserServer {serverId, deleted}) = case serverId of + upsertOrDeleteSrv :: ProtocolTypeI p => SProtocolType p -> AUserServer p -> IO (Maybe (UserServer p)) + upsertOrDeleteSrv p (AUS _ s@UserServer {serverId, deleted}) = case serverId of DBNewEntity | deleted -> pure Nothing | otherwise -> Just <$> insertProtocolServer db p user ts s DBEntityId srvId | deleted -> Nothing <$ DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND smp_server_id = ? AND preset = ?" (userId, srvId, BI False) | otherwise -> Just s <$ updateProtocolServer db p ts s + upsertOrDeleteCRelay :: AUserChatRelay -> IO (Maybe UserChatRelay) + upsertOrDeleteCRelay (AUCR _ speer@UserChatRelay {chatRelayId, deleted}) = case chatRelayId of + DBNewEntity + | deleted -> pure Nothing + | otherwise -> Just <$> insertChatRelay db user ts speer + DBEntityId speerId + | deleted -> Nothing <$ DB.execute db "DELETE FROM chat_relays WHERE user_id = ? AND chat_relay_id = ? AND preset = ?" (userId, speerId, BI False) + | otherwise -> Just speer <$ updateChatRelay db ts speer createCall :: DB.Connection -> User -> Call -> UTCTime -> IO () createCall db user@User {userId} Call {contactId, callId, callUUID, chatItemId, callState} callTs = do diff --git a/src/Simplex/Chat/Store/SQLite/Migrations.hs b/src/Simplex/Chat/Store/SQLite/Migrations.hs index e568e2a663..e57f0284e6 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations.hs @@ -143,6 +143,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20250813_delivery_tasks import Simplex.Chat.Store.SQLite.Migrations.M20250919_group_summary import Simplex.Chat.Store.SQLite.Migrations.M20250922_remove_unused_connections import Simplex.Chat.Store.SQLite.Migrations.M20251007_connections_sync +import Simplex.Chat.Store.SQLite.Migrations.M20251016_chat_relays import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -285,7 +286,8 @@ schemaMigrations = ("20250813_delivery_tasks", m20250813_delivery_tasks, Just down_m20250813_delivery_tasks), ("20250919_group_summary", m20250919_group_summary, Just down_m20250919_group_summary), ("20250922_remove_unused_connections", m20250922_remove_unused_connections, Just down_m20250922_remove_unused_connections), - ("20251007_connections_sync", m20251007_connections_sync, Just down_m20251007_connections_sync) + ("20251007_connections_sync", m20251007_connections_sync, Just down_m20251007_connections_sync), + ("20251016_chat_relays", m20251016_chat_relays, Just down_m20251016_chat_relays) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20251016_chat_relays.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20251016_chat_relays.hs new file mode 100644 index 0000000000..b3287320d9 --- /dev/null +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20251016_chat_relays.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.SQLite.Migrations.M20251016_chat_relays where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20251016_chat_relays :: Query +m20251016_chat_relays = + [sql| +CREATE TABLE chat_relays( + chat_relay_id INTEGER PRIMARY KEY, + address TEXT NOT NULL, + name TEXT NOT NULL, + domains TEXT NOT NULL, + preset INTEGER NOT NULL DEFAULT 0, + tested INTEGER, + enabled INTEGER NOT NULL DEFAULT 1, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT NOT NULL DEFAULT(datetime('now')), + updated_at TEXT NOT NULL DEFAULT(datetime('now')), + UNIQUE(user_id, address), + UNIQUE(user_id, name) +); + +CREATE INDEX idx_chat_relays_user_id ON chat_relays(user_id); + +ALTER TABLE users ADD COLUMN is_user_chat_relay INTEGER NOT NULL DEFAULT 0; + +ALTER TABLE group_members ADD COLUMN is_chat_relay INTEGER NOT NULL DEFAULT 0; +|] + +down_m20251016_chat_relays :: Query +down_m20251016_chat_relays = + [sql| +ALTER TABLE group_members DROP COLUMN is_chat_relay; + +ALTER TABLE users DROP COLUMN is_user_chat_relay; + +DROP INDEX idx_chat_relays_user_id; + +DROP TABLE chat_relays; +|] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index 7d8f9d0dcd..0523a71436 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql @@ -38,7 +38,8 @@ CREATE TABLE users( user_member_profile_updated_at TEXT, ui_themes TEXT, active_order INTEGER NOT NULL DEFAULT 0, - auto_accept_member_contacts INTEGER NOT NULL DEFAULT 0, -- 1 for active user + auto_accept_member_contacts INTEGER NOT NULL DEFAULT 0, + is_user_chat_relay INTEGER NOT NULL DEFAULT 0, -- 1 for active user FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE RESTRICT @@ -195,6 +196,7 @@ CREATE TABLE group_members( support_chat_last_msg_from_member_ts TEXT, member_xcontact_id BLOB, member_welcome_shared_msg_id BLOB, + is_chat_relay INTEGER NOT NULL DEFAULT 0, FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE @@ -721,6 +723,20 @@ CREATE TABLE connections_sync( should_sync INTEGER NOT NULL DEFAULT 0, last_sync_ts TEXT ); +CREATE TABLE chat_relays( + chat_relay_id INTEGER PRIMARY KEY, + address TEXT NOT NULL, + name TEXT NOT NULL, + domains TEXT NOT NULL, + preset INTEGER NOT NULL DEFAULT 0, + tested INTEGER, + enabled INTEGER NOT NULL DEFAULT 1, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT NOT NULL DEFAULT(datetime('now')), + updated_at TEXT NOT NULL DEFAULT(datetime('now')), + UNIQUE(user_id, address), + UNIQUE(user_id, name) +); CREATE INDEX contact_profiles_index ON contact_profiles( display_name, full_name @@ -1184,6 +1200,7 @@ CREATE INDEX idx_connections_to_subscribe ON connections( user_id, to_subscribe ); +CREATE INDEX idx_chat_relays_user_id ON chat_relays(user_id); CREATE TRIGGER on_group_members_insert_update_summary AFTER INSERT ON group_members FOR EACH ROW diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 243db84da7..7fb3f72951 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -530,15 +530,15 @@ userQuery :: Query userQuery = [sql| SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences, - u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes + u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.is_user_chat_relay FROM users u JOIN contacts uct ON uct.contact_id = u.contact_id JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id |] -toUser :: (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, Maybe UIThemeEntityOverrides) -> User -toUser ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, uiThemes)) = - User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts = BoolDef autoAcceptMemberContacts, viewPwdHash, userMemberProfileUpdatedAt, uiThemes} +toUser :: (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, Maybe UIThemeEntityOverrides, BoolInt) -> User +toUser ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, uiThemes, BI userChatRelay)) = + User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts = BoolDef autoAcceptMemberContacts, viewPwdHash, userMemberProfileUpdatedAt, uiThemes, userChatRelay = BoolDef userChatRelay} where profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, preferences = userPreferences, localAlias = ""} fullPreferences = fullPreferences' userPreferences @@ -656,7 +656,7 @@ type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe Member type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (Maybe UIThemeEntityOverrides, Int64, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupMemberRow -type GroupMemberRow = (Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime) +type GroupMemberRow = (Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus, BoolInt) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime) type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences) @@ -678,13 +678,14 @@ toPreparedGroup = \case _ -> Nothing toGroupMember :: Int64 -> GroupMemberRow -> GroupMember -toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. profileRow :. (createdAt, updatedAt) :. (supportChatTs_, supportChatUnread, supportChatMemberAttention, supportChatMentions, supportChatLastMsgFromMemberTs)) = +toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_, BI isCRelay) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. profileRow :. (createdAt, updatedAt) :. (supportChatTs_, supportChatUnread, supportChatMemberAttention, supportChatMentions, supportChatLastMsgFromMemberTs)) = let memberProfile = rowToLocalProfile profileRow memberSettings = GroupMemberSettings {showMessages} blockedByAdmin = maybe False mrsBlocked memberRestriction_ invitedBy = toInvitedBy userContactId invitedById activeConn = Nothing memberChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer + isChatRelay = BoolDef isCRelay supportChat = case supportChatTs_ of Just chatTs -> Just @@ -702,7 +703,7 @@ groupMemberQuery :: Query groupMemberQuery = [sql| SELECT - m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction, + m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction, m.is_chat_relay, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, m.created_at, m.updated_at, m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, @@ -743,7 +744,7 @@ groupInfoQueryFields = g.ui_themes, g.summary_current_members_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri, -- 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, + mu.member_status, mu.show_messages, mu.member_restriction, mu.is_chat_relay, 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.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences, mu.created_at, mu.updated_at, mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts diff --git a/src/Simplex/Chat/Terminal.hs b/src/Simplex/Chat/Terminal.hs index e432343839..21781229e4 100644 --- a/src/Simplex/Chat/Terminal.hs +++ b/src/Simplex/Chat/Terminal.hs @@ -15,7 +15,7 @@ import Simplex.Chat.Core import Simplex.Chat.Help (chatWelcome) import Simplex.Chat.Library.Commands (_defaultNtfServers) import Simplex.Chat.Operators -import Simplex.Chat.Operators.Presets (operatorSimpleXChat) +import Simplex.Chat.Operators.Presets (operatorSimpleXChat, simplexChatRelays) import Simplex.Chat.Options import Simplex.Chat.Terminal.Input import Simplex.Chat.Terminal.Output @@ -50,7 +50,9 @@ terminalChatConfig = ], useSMP = 3, xftp = map (presetServer True) $ L.toList defaultXFTPServers, - useXFTP = 3 + useXFTP = 3, + chatRelays = simplexChatRelays, + useChatRelays = 2 } ], ntf = _defaultNtfServers, diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index bb86cb2522..4cffd7ca4b 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -118,6 +118,7 @@ instance ToField AgentUserId where toField (AgentUserId uId) = toField uId aUserId :: User -> UserId aUserId User {agentUserId = AgentUserId uId} = uId +-- TODO [chat relay] filter out chat relay users where necessary (e.g. loading list of users for UI) data User = User { userId :: UserId, agentUserId :: AgentUserId, @@ -133,13 +134,15 @@ data User = User sendRcptsSmallGroups :: Bool, autoAcceptMemberContacts :: BoolDef, userMemberProfileUpdatedAt :: Maybe UTCTime, - uiThemes :: Maybe UIThemeEntityOverrides + uiThemes :: Maybe UIThemeEntityOverrides, + userChatRelay :: BoolDef } deriving (Show) data NewUser = NewUser { profile :: Maybe Profile, - pastTimestamp :: Bool + pastTimestamp :: Bool, + userChatRelay :: Bool } deriving (Show) @@ -945,7 +948,8 @@ data GroupMember = GroupMember memberChatVRange :: VersionRangeChat, createdAt :: UTCTime, updatedAt :: UTCTime, - supportChat :: Maybe GroupSupportChat + supportChat :: Maybe GroupSupportChat, + isChatRelay :: BoolDef } deriving (Eq, Show) @@ -1027,7 +1031,8 @@ data NewGroupMember = NewGroupMember memInvitedByGroupMemberId :: Maybe GroupMemberId, localDisplayName :: ContactName, memProfileId :: Int64, - memContactId :: Maybe Int64 + memContactId :: Maybe Int64, + isChatRelay :: Bool } newtype MemberId = MemberId {unMemberId :: ByteString} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index bbccd514b4..71fbf843ce 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -123,7 +123,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [viewJSON chats] CRChats chats -> viewChats ts tz chats CRApiChat u chat _ -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat] - CRChatTags u tags -> ttyUser u $ [viewJSON tags] + CRChatTags u tags -> ttyUser u [viewJSON tags] CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure CRServerOperatorConditions (ServerOperatorConditions ops _ ca) -> viewServerOperators ops ca CRUserServers u uss -> ttyUser u $ concatMap viewUserServers uss <> (if testView then [] else serversUserHelp) @@ -1465,11 +1465,12 @@ subStatusStr = \case SSNoSub -> "no subscription" viewUserServers :: UserOperatorServers -> [StyledString] -viewUserServers (UserOperatorServers _ [] []) = [] -viewUserServers UserOperatorServers {operator, smpServers, xftpServers} = +viewUserServers (UserOperatorServers _ [] [] []) = [] +viewUserServers UserOperatorServers {operator, smpServers, xftpServers, chatRelays} = [plain $ maybe "Your servers" shortViewOperator operator] <> viewServers SPSMP smpServers <> viewServers SPXFTP xftpServers + <> viewChatRelays chatRelays where viewServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [UserServer p] -> [StyledString] viewServers _ [] = [] @@ -1492,6 +1493,19 @@ viewUserServers UserOperatorServers {operator, smpServers, xftpServers} = | otherwise = "disabled (servers known)" where rs = operatorRoles p op + viewChatRelays :: [UserChatRelay] -> [StyledString] + viewChatRelays [] = [] + viewChatRelays cRelays + | maybe True (\ServerOperator {enabled} -> enabled) operator = + ["Chat relays"] <> map (plain . (" " <>) . viewChatRelay) cRelays + | otherwise = [] + where + viewChatRelay UserChatRelay {name, address, preset, tested, enabled} = name <> chatrelayAddress <> chatrelayInfo + where + chatrelayAddress = "(" <> safeDecodeUtf8 (strEncode address) <> ")" + chatrelayInfo = if null chatrelayInfo_ then "" else parens $ T.intercalate ", " chatrelayInfo_ + chatrelayInfo_ = ["preset" | preset] <> testedInfo <> ["disabled" | not enabled] + testedInfo = maybe [] (\t -> ["test: " <> if t then "passed" else "failed"]) tested serversUserHelp :: [StyledString] serversUserHelp = @@ -2409,6 +2423,7 @@ viewChatError isCmd logLevel testView = \case CENoRcvFileUser aFileId -> ["error: rcv file user not found, file id: " <> sShow aFileId | logLevel <= CLLError] CEActiveUserExists -> ["error: active user already exists"] CEUserExists name -> ["user with the name " <> ttyContact name <> " already exists"] + CEChatRelayExists -> ["chat realy user already exists"] CEUserUnknown -> ["user does not exist or incorrect password"] CEDifferentActiveUser commandUserId activeUserId -> ["error: different active user, command user id: " <> sShow commandUserId <> ", active user id: " <> sShow activeUserId] CECantDeleteActiveUser _ -> ["cannot delete active user"] diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 8fd8a5976d..5e5113d7a6 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -286,7 +286,7 @@ createTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> Profile -> I createTestChat ps cfg opts@ChatOpts {coreOptions} dbPrefix profile = do Right db@ChatDatabase {chatStore, agentStore} <- createDatabase ps coreOptions dbPrefix insertUser agentStore - Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile True + Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile False True startTestChat_ ps db cfg opts user startTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> IO TestCC diff --git a/tests/JSONFixtures.hs b/tests/JSONFixtures.hs index f02d04491e..680eccb7b6 100644 --- a/tests/JSONFixtures.hs +++ b/tests/JSONFixtures.hs @@ -17,10 +17,10 @@ activeUserExistsTagged :: LB.ByteString activeUserExistsTagged = "{\"error\":{\"type\":\"error\",\"errorType\":{\"type\":\"userExists\",\"contactName\":\"alice\"}}}" activeUserSwift :: LB.ByteString -activeUserSwift = "{\"result\":{\"_owsf\":true,\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"\",\"shortDescr\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"files\":{\"allow\":\"always\"},\"calls\":{\"allow\":\"yes\"},\"sessions\":{\"allow\":\"no\"},\"commands\":[]},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true,\"autoAcceptMemberContacts\":false}}}}" +activeUserSwift = "{\"result\":{\"_owsf\":true,\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"\",\"shortDescr\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"files\":{\"allow\":\"always\"},\"calls\":{\"allow\":\"yes\"},\"sessions\":{\"allow\":\"no\"},\"commands\":[]},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true,\"autoAcceptMemberContacts\":false,\"userChatRelay\":false}}}}" activeUserTagged :: LB.ByteString -activeUserTagged = "{\"result\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"\",\"shortDescr\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"files\":{\"allow\":\"always\"},\"calls\":{\"allow\":\"yes\"},\"sessions\":{\"allow\":\"no\"},\"commands\":[]},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true,\"autoAcceptMemberContacts\":false}}}" +activeUserTagged = "{\"result\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"\",\"shortDescr\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"files\":{\"allow\":\"always\"},\"calls\":{\"allow\":\"yes\"},\"sessions\":{\"allow\":\"no\"},\"commands\":[]},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true,\"autoAcceptMemberContacts\":false,\"userChatRelay\":false}}}" chatStartedSwift :: LB.ByteString chatStartedSwift = "{\"result\":{\"_owsf\":true,\"chatStarted\":{}}}" @@ -29,7 +29,7 @@ chatStartedTagged :: LB.ByteString chatStartedTagged = "{\"result\":{\"type\":\"chatStarted\"}}" userJSON :: LB.ByteString -userJSON = "{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"\",\"shortDescr\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"files\":{\"allow\":\"always\"},\"calls\":{\"allow\":\"yes\"},\"sessions\":{\"allow\":\"no\"},\"commands\":[]},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true,\"autoAcceptMemberContacts\":false}" +userJSON = "{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"\",\"shortDescr\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"files\":{\"allow\":\"always\"},\"calls\":{\"allow\":\"yes\"},\"sessions\":{\"allow\":\"no\"},\"commands\":[]},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true,\"autoAcceptMemberContacts\":false,\"userChatRelay\":false}" parsedMarkdownSwift :: LB.ByteString parsedMarkdownSwift = "{\"formattedText\":[{\"format\":{\"_owsf\":true,\"bold\":{}},\"text\":\"hello\"}]}" diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index d4f65b3b1c..84a4dd6408 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -136,7 +136,7 @@ testChatApi ps = do dbPrefix = tmp "1" f = dbPrefix <> chatSuffix Right st <- createChatStore (DBOpts f "myKey" False True DB.TQOff) (MigrationConfig MCYesUp Nothing) - Right _ <- withTransaction st $ \db -> runExceptT $ createUserRecord db (AgentUserId 1) aliceProfile {preferences = Nothing} True + Right _ <- withTransaction st $ \db -> runExceptT $ createUserRecord db (AgentUserId 1) aliceProfile {preferences = Nothing} False True Right cc <- chatMigrateInit dbPrefix "myKey" "yesUp" Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "" "yesUp" Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "anotherKey" "yesUp" diff --git a/tests/OperatorTests.hs b/tests/OperatorTests.hs index 656f0ae0e2..8e6ab69f36 100644 --- a/tests/OperatorTests.hs +++ b/tests/OperatorTests.hs @@ -24,6 +24,7 @@ import Simplex.Chat.Types import Simplex.FileTransfer.Client.Presets (defaultXFTPServers) import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..), allRoles) import Simplex.Messaging.Agent.Store.Entity +import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol import Test.Hspec @@ -34,18 +35,36 @@ operatorTests = describe "managing server operators" $ do validateServersTest :: Spec validateServersTest = describe "validate user servers" $ do - it "should pass valid user servers" $ validateUserServers [valid] [] `shouldBe` [] + it "should pass valid user servers" $ validateUserServers [valid] [] `shouldBe` ([], []) it "should fail without servers" $ do - validateUserServers [invalidNoServers] [] `shouldBe` [USENoServers aSMP Nothing] - validateUserServers [invalidDisabled] [] `shouldBe` [USENoServers aSMP Nothing] - validateUserServers [invalidDisabledOp] [] `shouldBe` [USENoServers aSMP Nothing, USENoServers aXFTP Nothing] + validateUserServers [invalidNoServers] [] `shouldBe` ([USENoServers aSMP Nothing], []) + validateUserServers [invalidDisabled] [] `shouldBe` ([USENoServers aSMP Nothing], []) + validateUserServers [invalidDisabledOp] [] `shouldBe` ([USENoServers aSMP Nothing, USENoServers aXFTP Nothing], [USWNoChatRelays Nothing]) it "should fail without servers with storage role" $ do - validateUserServers [invalidNoStorage] [] `shouldBe` [USEStorageMissing aSMP Nothing] + validateUserServers [invalidNoStorage] [] `shouldBe` ([USEStorageMissing aSMP Nothing], []) it "should fail with duplicate host" $ do - validateUserServers [invalidDuplicate] [] `shouldBe` - [ USEDuplicateServer aSMP "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion" "smp8.simplex.im", - USEDuplicateServer aSMP "smp://abcd@smp8.simplex.im" "smp8.simplex.im" - ] + validateUserServers [invalidDuplicateSrv] [] + `shouldBe` ( [ USEDuplicateServer aSMP "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion" "smp8.simplex.im", + USEDuplicateServer aSMP "smp://abcd@smp8.simplex.im" "smp8.simplex.im" + ], + [] + ) + it "should warn without chat relays" $ + validateUserServers [invalidNoChatRelays] [] `shouldBe` ([], [USWNoChatRelays Nothing]) + it "should fail with duplicate chat relay name" $ do + validateUserServers [invalidDuplicateChatRelayName] [] + `shouldBe` ( [ USEDuplicateChatRelayName "chat_relay_1", + USEDuplicateChatRelayName "chat_relay_1" + ], + [] + ) + it "should fail with duplicate chat relay address" $ do + validateUserServers [invalidDuplicateChatRelayAddress] [] + `shouldBe` ( [ USEDuplicateChatRelayAddress "chat_relay_1" duplicateAddr, + USEDuplicateChatRelayAddress "chat_relay_4" duplicateAddr + ], + [] + ) where aSMP = AProtocolType SPSMP aXFTP = AProtocolType SPXFTP @@ -59,7 +78,7 @@ updatedServersTest = describe "validate user servers" $ do all addedPreset ops' `shouldBe` True let ops'' :: [(Maybe PresetOperator, Maybe ServerOperator)] = saveOps ops' -- mock getUpdateServerOperators - uss <- groupByOperator' (ops'', [], []) -- no stored servers + uss <- groupByOperator' (ops'', [], [], []) -- no stored servers length uss `shouldBe` 3 [op1, op2, op3] <- pure $ map updatedUserServers uss [p1, p2] <- pure operators -- presets @@ -67,14 +86,15 @@ updatedServersTest = describe "validate user servers" $ do sameServers p2 op2 null (servers' SPSMP op3) `shouldBe` True null (servers' SPXFTP op3) `shouldBe` True - it "adding preset operators and assiging servers to operator for existing users" $ do + it "adding preset operators and assigning servers to operator for existing users" $ do let ops' = updatedServerOperators operators [] ops'' = saveOps ops' uss <- groupByOperator' ( ops'', saveSrvs $ take 3 simplexChatSMPServers <> [newUserServer "smp://abcd@smp.example.im"], - saveSrvs $ map (presetServer True) $ L.take 3 defaultXFTPServers + saveSrvs $ map (presetServer True) $ L.take 3 defaultXFTPServers, + [] ) [op1, op2, op3] <- pure $ map updatedUserServers uss [p1, p2] <- pure operators -- presets @@ -86,8 +106,8 @@ updatedServersTest = describe "validate user servers" $ do addedPreset = \case (Just PresetOperator {operator = Just op}, Just (ASO SDBNew op')) -> operatorTag op == operatorTag op' _ -> False - saveOps = zipWith (\i -> second ((\(ASO _ op) -> op {operatorId = DBEntityId i}) <$>)) [1..] - saveSrvs = zipWith (\i srv -> srv {serverId = DBEntityId i}) [1..] + saveOps = zipWith (\i -> second ((\(ASO _ op) -> op {operatorId = DBEntityId i}) <$>)) [1 ..] + saveSrvs = zipWith (\i srv -> srv {serverId = DBEntityId i}) [1 ..] sameServers preset op = do map srvHost (pServers SPSMP preset) `shouldBe` map srvHost' (servers' SPSMP op) map srvHost (pServers SPXFTP preset) `shouldBe` map srvHost' (servers' SPXFTP op) @@ -98,12 +118,15 @@ deriving instance Eq User deriving instance Eq UserServersError +deriving instance Eq UserServersWarning + valid :: UpdatedUserOperatorServers valid = UpdatedUserOperatorServers { operator = Just operatorSimpleXChat {operatorId = DBEntityId 1}, smpServers = map (AUS SDBNew) simplexChatSMPServers, - xftpServers = map (AUS SDBNew . presetServer True) $ L.toList defaultXFTPServers + xftpServers = map (AUS SDBNew . presetServer True) $ L.toList defaultXFTPServers, + chatRelays = map (AUCR SDBNew) simplexChatRelays } invalidNoServers :: UpdatedUserOperatorServers @@ -127,8 +150,26 @@ invalidNoStorage = { operator = Just operatorSimpleXChat {operatorId = DBEntityId 1, smpRoles = allRoles {storage = False}} } -invalidDuplicate :: UpdatedUserOperatorServers -invalidDuplicate = +invalidDuplicateSrv :: UpdatedUserOperatorServers +invalidDuplicateSrv = (valid :: UpdatedUserOperatorServers) { smpServers = map (AUS SDBNew) $ simplexChatSMPServers <> [presetServer True "smp://abcd@smp8.simplex.im"] } + +invalidNoChatRelays :: UpdatedUserOperatorServers +invalidNoChatRelays = (valid :: UpdatedUserOperatorServers) {chatRelays = []} + +invalidDuplicateChatRelayName :: UpdatedUserOperatorServers +invalidDuplicateChatRelayName = + (valid :: UpdatedUserOperatorServers) + { chatRelays = map (AUCR SDBNew) $ simplexChatRelays <> [presetChatRelay True "chat_relay_1" ["simplex.im"] (either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp444.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D")] + } + +invalidDuplicateChatRelayAddress :: UpdatedUserOperatorServers +invalidDuplicateChatRelayAddress = + (valid :: UpdatedUserOperatorServers) + { chatRelays = map (AUCR SDBNew) $ simplexChatRelays <> [presetChatRelay True "chat_relay_4" ["simplex.im"] duplicateAddr] + } + +duplicateAddr :: ConnLinkContact +duplicateAddr = either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp111.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D"