diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index ff1be20c2b..87d513e87e 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -84,7 +84,7 @@ import Simplex.Chat.Store.Shared import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.Shared -import Simplex.Chat.Util (liftIOEither, zipWith3') +import Simplex.Chat.Util (liftIOEither, shuffle, zipWith3') import qualified Simplex.Chat.Util as U import Simplex.FileTransfer.Description (FileDescriptionURI (..), maxFileSize, maxFileSizeHard) import Simplex.Messaging.Agent @@ -2708,23 +2708,27 @@ processChatCommand vr nm = \case pure (gLink, gInfo') if autoChooseRelays then do - relayIds <- chooseRelays - relays <- addRelays user gInfo' relayIds - pure $ CRGroupRelaysAdded user gInfo' gLink relays + relays <- chooseRelays user + groupRelays <- addRelays user gInfo' relays + pure $ CRGroupRelaysAdded user gInfo' gLink groupRelays else pure $ CRGroupLinkCreated user gInfo' gLink where - chooseRelays = do - -- TODO - load configured relays (chat_relays) - -- TODO - select 3 random relays - pure [] + chooseRelays user = do + -- TODO [relays] owner: more advanced relay selection strategy, e.g. pick from different operators + chatRelays <- withFastStore' (`getChatRelays` user) + let enabledRelays = filter (\UserChatRelay {enabled} -> enabled) chatRelays + selectedRelays <- take 3 <$> liftIO (shuffle enabledRelays) + when (null selectedRelays) $ throwChatError $ CEException "failed to select relays: no enabled relays configured" + pure selectedRelays APIAddRelays groupId relayIds -> withUser $ \user -> withGroupLock "addRelays" groupId $ do (gInfo, gLink) <- withFastStore $ \db -> do gInfo <- getGroupInfo db vr user groupId gLink <- getGroupLink db user gInfo pure (gInfo, gLink) - relays <- addRelays user gInfo $ L.toList relayIds - pure $ CRGroupRelaysAdded user gInfo gLink relays + relays <- withFastStore $ \db -> mapM (getChatRelayById db user) (L.toList relayIds) + groupRelays <- addRelays user gInfo relays + pure $ CRGroupRelaysAdded user gInfo gLink groupRelays APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withGroupLock "groupLinkMemberRole" groupId $ do gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId gLnk@GroupLink {acceptMemberRole} <- withFastStore $ \db -> getGroupLink db user gInfo @@ -3567,8 +3571,8 @@ processChatCommand vr nm = \case toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] forM_ (timed_ >>= timedDeleteAt') $ startProximateTimedItemThread user (ChatRef CTDirect contactId Nothing, chatItemId' ci) - addRelays :: User -> GroupInfo -> [Int64] -> CM [GroupRelay] - addRelays _user _gInfo _relayIds = do + addRelays :: User -> GroupInfo -> [UserChatRelay] -> CM [GroupRelay] + addRelays _user _gInfo _relays = do -- TODO [relays] owner: send contact requests to relays -- TODO - create relay member connections, relay records (group_relays), relay status: RSNew -- TODO - send requests to relays: INV message - XGrpRelayInv, relay status: RSInvited diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 87086f6bd4..9d225570f4 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -58,6 +58,7 @@ module Simplex.Chat.Store.Profiles updateUserAddressSettings, getProtocolServers, getChatRelays, + getChatRelayById, insertProtocolServer, getUpdateServerOperators, getServerOperators, @@ -624,10 +625,22 @@ getChatRelays db User {userId} = WHERE user_id = ? |] (Only userId) - where - toChatRelay :: (DBEntityId, ShortLinkContact, 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} + +toChatRelay :: (DBEntityId, ShortLinkContact, 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} + +getChatRelayById :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO UserChatRelay +getChatRelayById db User {userId} relayId = + ExceptT . firstRow toChatRelay (SEUserChatRelayNotFound relayId) $ + DB.query + db + [sql| + SELECT chat_relay_id, address, name, domains, preset, tested, enabled + FROM chat_relays + WHERE user_id = ? AND chat_relay_id = ? + |] + (userId, relayId) insertChatRelay :: DB.Connection -> User -> UTCTime -> NewUserChatRelay -> IO UserChatRelay insertChatRelay db User {userId} ts relay@UserChatRelay {address, name, domains, preset, tested, enabled} = do @@ -642,7 +655,7 @@ insertChatRelay db User {userId} ts relay@UserChatRelay {address, name, domains, RETURNING chat_relay_id |] (address, name, T.intercalate "," domains, BI preset, BI <$> tested, BI enabled, userId, ts, ts) - pure relay {chatRelayId = DBEntityId crId} + pure (relay :: NewUserChatRelay) {chatRelayId = DBEntityId crId} updateChatRelay :: DB.Connection -> UTCTime -> UserChatRelay -> IO () updateChatRelay db ts UserChatRelay {chatRelayId, address, name, domains, preset, tested, enabled} = diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index c71ae31689..c0ded28bd2 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -147,6 +147,7 @@ data StoreError | SEProhibitedDeleteUser {userId :: UserId, contactId :: ContactId} | SEOperatorNotFound {serverOperatorId :: Int64} | SEUsageConditionsNotFound + | SEUserChatRelayNotFound {chatRelayId :: Int64} | SEInvalidQuote | SEInvalidMention | SEInvalidDeliveryTask {taskId :: Int64}