cli: remove multiple members (#5656)

* cli: remove multiple members

* accept all members joining via link as observers (do NOT release)

* blocked words

* blocked words

* XGrpLinkReject

* core: 6.3.0.6 (simplexmq 6.3.0.6)

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Evgeny 2025-02-25 09:24:30 +00:00 committed by Evgeny Poberezkin
parent 981901d587
commit 511ff1d35c
No known key found for this signature in database
GPG key ID: 494BDDD9A28B577D
19 changed files with 267 additions and 36 deletions

View file

@ -6,7 +6,6 @@ import Directory.Options
import Directory.Service
import Directory.Store
import Simplex.Chat.Core
import Simplex.Chat.Terminal (terminalChatConfig)
main :: IO ()
main = do
@ -14,4 +13,6 @@ main = do
st <- restoreDirectoryStore directoryLog
if runCLI
then directoryServiceCLI st opts
else simplexChatCore terminalChatConfig (mkChatOpts opts) $ directoryService st opts
else do
cfg <- directoryChatConfig opts
simplexChatCore cfg (mkChatOpts opts) $ directoryService st opts

View file

@ -0,0 +1,64 @@
module Directory.BlockedWords where
import Data.Char (isMark, isPunctuation, isSpace)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Normalize as TN
containsBlockedWords :: Map Char [Char] -> [String] -> Text -> Bool
containsBlockedWords spelling blockedWords s =
let normalizedWords = concatMap words $ normalizeText spelling s
-- Fully normalize the entire string (no spaces or punctuation)
fullNorm = normalizeText spelling $ T.filter (not . isSpace) s
-- Check if any individual word is a swear word
wordCheck = any (`elem` blockedWords) normalizedWords
-- Check if the full string, when normalized, matches a swear word exactly
fullCheck = any (\bw -> T.length s <= length bw * 2 && any (bw ==) fullNorm) blockedWords
-- Check if the string is a single word (no spaces)
isSingleWord = not $ T.any isSpace s
in wordCheck || (fullCheck && not isSingleWord)
normalizeText :: Map Char [Char] -> Text -> [String]
normalizeText spelling =
filter (not . null)
. map (filter (\c -> not (isPunctuation c) && not (isMark c)))
. allSubstitutions spelling
. removeTriples
. T.unpack
. T.toLower
. TN.normalize TN.NFKD
-- replaces triple and larger occurences with doubles
removeTriples :: String -> String
removeTriples xs = go xs '\0' False
where
go [] _ _ = []
go (c : cs) prev samePrev
| prev /= c = c : go cs c False
| samePrev = go cs c True
| otherwise = c : go cs c True
-- Generate all possible strings by substituting each character
allSubstitutions :: Map Char [Char] -> String -> [String]
allSubstitutions spelling = sequence . map substs
where
substs c = fromMaybe [c] $ M.lookup c spelling
wordVariants :: [(String, [String])] -> String -> [String]
wordVariants [] s = [s]
wordVariants (sub : subs) s = concatMap (wordVariants subs) (replace sub)
where
replace (pat, tos) = go s
where
go [] = [""]
go s'@(c : rest)
| pat `isPrefixOf` s' =
let s'' = drop (length pat) s'
restVariants = go s''
in map (pat <>) restVariants
<> concatMap (\to -> map (to <>) restVariants) tos
| otherwise = map (c :) (go rest)

View file

@ -1,5 +1,6 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
@ -12,9 +13,10 @@ module Directory.Options
where
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Options.Applicative
import Simplex.Chat.Bot.KnownContacts
import Simplex.Chat.Controller (updateStr, versionNumber, versionString)
import Simplex.Chat.Controller (AcceptAsObserver (..), updateStr, versionNumber, versionString)
import Simplex.Chat.Options (ChatCmdLog (..), ChatOpts (..), CoreChatOpts, coreChatOptsP)
data DirectoryOpts = DirectoryOpts
@ -22,6 +24,11 @@ data DirectoryOpts = DirectoryOpts
adminUsers :: [KnownContact],
superUsers :: [KnownContact],
ownersGroup :: Maybe KnownGroup,
blockedWordsFile :: Maybe FilePath,
blockedExtensionRules :: Maybe FilePath,
nameSpellingFile :: Maybe FilePath,
profileNameLimit :: Int,
acceptAsObserver :: Maybe AcceptAsObserver,
directoryLog :: Maybe FilePath,
serviceName :: T.Text,
runCLI :: Bool,
@ -55,6 +62,43 @@ directoryOpts appDir defaultDbName = do
<> metavar "OWNERS_GROUP"
<> help "The group of group owners in the format GROUP_ID:DISPLAY_NAME - owners of listed groups will be invited automatically"
)
blockedWordsFile <-
optional $
strOption
( long "blocked-words-file"
<> metavar "BLOCKED_WORDS_FILE"
<> help "File with the basic forms of words not allowed in profiles and groups"
)
blockedExtensionRules <-
optional $
strOption
( long "blocked-extenstion-rules"
<> metavar "BLOCKED_EXTENSION_RULES"
<> help "Substitions to extend the list of blocked words"
)
nameSpellingFile <-
optional $
strOption
( long "name-spelling-file"
<> metavar "NAME_SPELLING_FILE"
<> help "File with the character substitions to match in profile names"
)
profileNameLimit <-
option
auto
( long "profile-name-limit"
<> metavar "PROFILE_NAME_LIMIT"
<> help "Max length of profile name that will be allowed to connect and to join groups"
<> value maxBound
)
acceptAsObserver <-
optional $
option
parseAcceptAsObserver
( long "accept-as-observer"
<> metavar "ACCEPT_AS_OBSERVER"
<> help "Whether to accept all or some of the joining members without posting rights ('all', 'no-image', 'incognito')"
)
directoryLog <-
Just
<$> strOption
@ -80,6 +124,11 @@ directoryOpts appDir defaultDbName = do
adminUsers,
superUsers,
ownersGroup,
blockedWordsFile,
blockedExtensionRules,
nameSpellingFile,
profileNameLimit,
acceptAsObserver,
directoryLog,
serviceName = T.pack serviceName,
runCLI,
@ -116,3 +165,12 @@ mkChatOpts DirectoryOpts {coreOptions} =
markRead = False,
maintenance = False
}
parseAcceptAsObserver :: ReadM AcceptAsObserver
parseAcceptAsObserver = eitherReader $ decodeAAO . encodeUtf8 . T.pack
where
decodeAAO = \case
"all" -> Right AOAll
"name-only" -> Right AONameOnly
"incognito" -> Right AOIncognito
_ -> Left "bad AcceptAsObserver"

View file

@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
@ -10,6 +11,7 @@ module Directory.Service
( welcomeGetOpts,
directoryService,
directoryServiceCLI,
directoryChatConfig
)
where
@ -18,7 +20,10 @@ import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Logger.Simple
import Control.Monad
import Data.Composition ((.:))
import Data.Containers.ListUtils (nubOrd)
import Data.List (find, intercalate)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, isJust, maybeToList)
import Data.Set (Set)
import qualified Data.Set as S
@ -26,6 +31,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import Data.Time.LocalTime (getCurrentTimeZone)
import Directory.BlockedWords
import Directory.Events
import Directory.Options
import Directory.Search
@ -97,8 +103,9 @@ directoryServiceCLI st opts = do
env <- newServiceState
eventQ <- newTQueueIO
let eventHook cc resp = atomically $ resp <$ writeTQueue eventQ (cc, resp)
cfg <- directoryChatConfig opts
race_
(simplexChatCLI' terminalChatConfig {chatHooks = defaultChatHooks {eventHook}} (mkChatOpts opts) Nothing)
(simplexChatCLI' cfg {chatHooks = defaultChatHooks {eventHook}} (mkChatOpts opts) Nothing)
(processEvents eventQ env)
where
processEvents eventQ env = forever $ do
@ -114,6 +121,16 @@ directoryService st opts@DirectoryOpts {testing} user cc = do
(_, _, resp) <- atomically . readTBQueue $ outputQ cc
directoryServiceEvent st opts env user cc resp
directoryChatConfig :: DirectoryOpts -> IO ChatConfig
directoryChatConfig DirectoryOpts {blockedWordsFile, nameSpellingFile, blockedExtensionRules, profileNameLimit, acceptAsObserver} = do
blockedWords <- mapM (fmap lines . readFile) blockedWordsFile
spelling <- maybe (pure M.empty) (fmap (M.fromList . read) . readFile) nameSpellingFile
extensionRules <- maybe (pure []) (fmap read . readFile) blockedExtensionRules
let !bws = nubOrd . concatMap (wordVariants extensionRules) <$> blockedWords
!allowedProfileName = not .: containsBlockedWords spelling <$> bws
putStrLn $ "Blocked words: " <> show (maybe 0 length bws) <> ", spelling rules: " <> show (M.size spelling)
pure terminalChatConfig {allowedProfileName, profileNameLimit, acceptAsObserver}
directoryServiceEvent :: DirectoryStore -> DirectoryOpts -> ServiceState -> User -> ChatController -> ChatResponse -> IO ()
directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, ownersGroup, searchResults} ServiceState {searchRequests} user@User {userId} cc event =
forM_ (crDirectoryEvent event) $ \case

View file

@ -407,6 +407,7 @@ executable simplex-directory-service
default-extensions:
StrictData
other-modules:
Directory.BlockedWords
Directory.Events
Directory.Options
Directory.Search
@ -427,6 +428,7 @@ executable simplex-directory-service
, simplexmq >=6.3
, stm ==2.5.*
, time ==1.12.*
, unicode-transforms ==0.4.*
default-language: Haskell2010
if flag(client_postgres)
cpp-options: -DdbPostgres
@ -517,6 +519,7 @@ test-suite simplex-chat-test
, stm ==2.5.*
, terminal ==0.2.*
, time ==1.12.*
, unicode-transforms ==0.4.*
, unliftio ==0.2.*
default-language: Haskell2010
if flag(client_postgres)

View file

@ -112,6 +112,9 @@ defaultChatConfig =
ntf = _defaultNtfServers,
netCfg = defaultNetworkConfig
},
allowedProfileName = Nothing,
profileNameLimit = maxBound,
acceptAsObserver = Nothing,
tbqSize = 1024,
fileChunkSize = 15780, -- do not change
xftpDescrPartSize = 14000,

View file

@ -137,6 +137,9 @@ data ChatConfig = ChatConfig
chatVRange :: VersionRangeChat,
confirmMigrations :: MigrationConfirmation,
presetServers :: PresetServers,
allowedProfileName :: Maybe (ContactName -> Bool),
profileNameLimit :: Int,
acceptAsObserver :: Maybe AcceptAsObserver,
tbqSize :: Natural,
fileChunkSize :: Integer,
xftpDescrPartSize :: Int,
@ -158,6 +161,11 @@ data ChatConfig = ChatConfig
chatHooks :: ChatHooks
}
data AcceptAsObserver
= AOAll -- all members
| AONameOnly -- members without image
| AOIncognito -- members with incognito-style names and without image
data RandomAgentServers = RandomAgentServers
{ smpServers :: NonEmpty (ServerCfg 'PSMP),
xftpServers :: NonEmpty (ServerCfg 'PXFTP)
@ -481,7 +489,7 @@ data ChatCommand
| JoinGroup {groupName :: GroupName, enableNtfs :: MsgFilter}
| MemberRole GroupName ContactName GroupMemberRole
| BlockForAll GroupName ContactName Bool
| RemoveMember GroupName ContactName
| RemoveMembers GroupName (NonEmpty ContactName)
| LeaveGroup GroupName
| DeleteGroup GroupName
| ClearGroup GroupName

View file

@ -2116,7 +2116,16 @@ processChatCommand' vr = \case
processChatCommand $ APIJoinGroup groupId enableNtfs
MemberRole gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIMemberRole gId gMemberId memRole
BlockForAll gName gMemberName blocked -> withMemberName gName gMemberName $ \gId gMemberId -> APIBlockMemberForAll gId gMemberId blocked
RemoveMember gName gMemberName -> withMemberName gName gMemberName APIRemoveMember
RemoveMembers gName gMemberNames -> withUser $ \user -> do
(gId, gMemberIds) <- withStore $ \db -> do
gId <- getGroupIdByName db user gName
gMemberIds <- forM gMemberNames $ getGroupMemberIdByName db user gId
pure (gId, gMemberIds)
rs <- forM (L.zip (L.fromList [1..]) gMemberIds) $ \(i, memId) -> do
r <- processChatCommand (APIRemoveMember gId memId)
when (i < length gMemberIds) $ toView r
pure r
pure $ L.last rs
LeaveGroup gName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
processChatCommand $ APILeaveGroup groupId
@ -3873,7 +3882,7 @@ chatCommandP =
("/member role " <|> "/mr ") *> char_ '#' *> (MemberRole <$> displayNameP <* A.space <* char_ '@' <*> displayNameP <*> memberRole),
"/block for all #" *> (BlockForAll <$> displayNameP <* A.space <*> (char_ '@' *> displayNameP) <*> pure True),
"/unblock for all #" *> (BlockForAll <$> displayNameP <* A.space <*> (char_ '@' *> displayNameP) <*> pure False),
("/remove " <|> "/rm ") *> char_ '#' *> (RemoveMember <$> displayNameP <* A.space <* char_ '@' <*> displayNameP),
("/remove " <|> "/rm ") *> char_ '#' *> (RemoveMembers <$> displayNameP <* A.space <*> (L.fromList <$> (char_ '@' *> displayNameP) `A.sepBy1'` A.char ',')),
("/leave " <|> "/l ") *> char_ '#' *> (LeaveGroup <$> displayNameP),
("/delete #" <|> "/d #") *> (DeleteGroup <$> displayNameP),
("/delete " <|> "/d ") *> char_ '@' *> (DeleteContact <$> displayNameP <*> chatDeleteMode),

View file

@ -48,7 +48,7 @@ import Simplex.Chat.Library.Internal
import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Messages.CIContent.Events
import Simplex.Chat.ProfileGenerator (generateRandomProfile)
import Simplex.Chat.ProfileGenerator (generateRandomProfile, isRandomName)
import Simplex.Chat.Protocol
import Simplex.Chat.Store
import Simplex.Chat.Store.Connections
@ -1290,8 +1290,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
_ -> pure ()
where
profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> CM ()
profileContactRequest invId chatVRange p xContactId_ reqPQSup = do
withStore (\db -> createOrUpdateContactRequest db vr user userContactLinkId invId chatVRange p xContactId_ reqPQSup) >>= \case
profileContactRequest invId chatVRange p@Profile {displayName, image} xContactId_ reqPQSup = do
cfg <- asks config
withAllowedName cfg $ withStore (\db -> createOrUpdateContactRequest db vr user userContactLinkId invId chatVRange p xContactId_ reqPQSup) >>= \case
CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact
CORGroup gInfo -> toView $ CRBusinessRequestAlreadyAccepted user gInfo
CORRequest cReq -> do
@ -1320,11 +1321,23 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
if v >= groupFastLinkJoinVersion
then do
mem <- acceptGroupJoinRequestAsync user gInfo cReq gLinkMemRole profileMode
let useRole = userMemberRole gLinkMemRole $ acceptAsObserver cfg
mem <- acceptGroupJoinRequestAsync user gInfo cReq useRole profileMode
createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
toView $ CRAcceptingGroupJoinRequestMember user gInfo mem
else messageError "processUserContactRequest: chat version range incompatible for accepting group join request"
_ -> toView $ CRReceivedContactRequest user cReq
where
withAllowedName ChatConfig {profileNameLimit, allowedProfileName} action
| T.length displayName <= profileNameLimit && maybe True ($ displayName) allowedProfileName = action
| otherwise = liftIO $ putStrLn $ "Joining of " <> T.unpack displayName <> " is blocked" -- TODO send response, maybe event to UI?
userMemberRole linkRole = \case
Just AOAll -> GRObserver
Just AONameOnly | noImage -> GRObserver
Just AOIncognito | noImage && isRandomName displayName -> GRObserver
_ -> linkRole
where
noImage = maybe True (\(ImageData i) -> i == "") image
memberCanSend :: GroupMember -> CM () -> CM ()
memberCanSend GroupMember {memberRole} a

View file

@ -2,6 +2,8 @@
module Simplex.Chat.ProfileGenerator where
import qualified Data.Attoparsec.Text as A
import Data.Either (isRight)
import Data.Text (Text)
import Simplex.Chat.Types (Profile (..))
import System.Random (randomRIO)
@ -23,6 +25,15 @@ generateRandomProfile = do
then pickNoun adjective (n - 1)
else pure noun
-- This function does not check for exact match with this disctionary,
-- it only checks for the WordWord style.
isRandomName :: Text -> Bool
isRandomName = isRight . A.parseOnly randomNameP
where
randomNameP = A.satisfy upper >> A.takeWhile1 lower >> A.satisfy upper >> A.takeWhile1 lower >> A.endOfInput
upper c = c >= 'A' && c <= 'Z'
lower c = c >= 'a' && c <= 'z'
adjectives :: [Text]
adjectives =
[ "Abatic",

View file

@ -326,6 +326,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
XGrpAcpt :: MemberId -> ChatMsgEvent 'Json
XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json
-- XGrpLinkReject :: GroupProfile -> RejectionReason -> ChatMsgEvent 'Json
XGrpLinkMem :: Profile -> ChatMsgEvent 'Json
XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json
XGrpMemIntro :: MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json

View file

@ -141,9 +141,11 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
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,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
-- 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.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.image, p.contact_link, p.local_alias, p.preferences
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.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id

View file

@ -173,11 +173,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 ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
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 ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences) :. (Maybe UTCTime, 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, image, contactLink, Just localAlias, contactPreferences)) =
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences))
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, image, contactLink, Just localAlias, contactPreferences) :. (Just createdAt, Just updatedAt)) =
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences) :. (createdAt, updatedAt))
toMaybeGroupMember _ _ = Nothing
createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO ()
@ -281,9 +281,11 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr = do
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,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
-- 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.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.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
@ -469,7 +471,9 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
memberContactId = Just $ contactId' userOrContact,
memberContactProfileId = localProfileId (profile' userOrContact),
activeConn = Nothing,
memberChatVRange
memberChatVRange,
createdAt,
updatedAt = createdAt
}
where
memberChatVRange@(VersionRange minV maxV) = vr
@ -744,7 +748,8 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at
FROM groups g
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu USING (group_id)
@ -808,6 +813,7 @@ groupMemberQuery =
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.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.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
@ -975,7 +981,9 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId,
memberContactId = Just contactId,
memberContactProfileId = localProfileId profile,
activeConn = Nothing,
memberChatVRange = peerChatVRange
memberChatVRange = peerChatVRange,
createdAt,
updatedAt = createdAt
}
where
insertMember_ =
@ -1257,7 +1265,9 @@ createNewMember_
memberContactId,
memberContactProfileId,
activeConn,
memberChatVRange
memberChatVRange,
createdAt,
updatedAt = createdAt
}
checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId)
@ -1509,9 +1519,11 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = do
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,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
-- via 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, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,

View file

@ -515,7 +515,8 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
-- 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,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
LEFT JOIN contacts c ON m.contact_id = c.contact_id
@ -2521,16 +2522,19 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
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,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
-- quoted ChatItem
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,
rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
rm.created_at, rm.updated_at,
-- 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,
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences,
dbm.created_at, dbm.updated_at
FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
LEFT JOIN group_members m ON m.group_member_id = i.group_member_id

View file

@ -42,9 +42,11 @@ Query:
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,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
-- 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.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.image, p.contact_link, p.local_alias, p.preferences
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.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id
@ -555,7 +557,8 @@ Query:
-- 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,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
LEFT JOIN contacts c ON m.contact_id = c.contact_id
@ -704,16 +707,19 @@ Query:
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,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
-- quoted ChatItem
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,
rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
rm.created_at, rm.updated_at,
-- 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,
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences,
dbm.created_at, dbm.updated_at
FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
LEFT JOIN group_members m ON m.group_member_id = i.group_member_id
@ -790,9 +796,11 @@ Query:
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,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
-- via 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, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
@ -829,7 +837,8 @@ Query:
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at
FROM groups g
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu USING (group_id)
@ -4415,7 +4424,8 @@ Query:
-- 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,
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_id
@ -4436,7 +4446,8 @@ Query:
-- 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,
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_id
@ -4452,6 +4463,7 @@ Query:
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.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.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
@ -4483,6 +4495,7 @@ Query:
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.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.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
@ -4506,6 +4519,7 @@ Query:
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.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.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
@ -4529,6 +4543,7 @@ Query:
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.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.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
@ -4552,6 +4567,7 @@ Query:
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.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.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
@ -4575,6 +4591,7 @@ Query:
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.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.image, p.contact_link, p.local_alias, p.preferences,
m.created_at, m.updated_at,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,

View file

@ -579,7 +579,7 @@ type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe Member
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Text, Maybe Text, Maybe ImageData, Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. BusinessChatInfoRow :. (Maybe UIThemeEntityOverrides, Maybe CustomData, Maybe Int64) :. GroupMemberRow
type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
type GroupMemberRow = (Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences) :. (UTCTime, UTCTime)
toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, localAlias, description, image, enableNtfs_, sendRcpts, BI favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. businessRow :. (uiThemes, customData, chatItemTTL) :. userMemberRow) =
@ -591,7 +591,7 @@ toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName,
in GroupInfo {groupId, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, chatTags, chatItemTTL, uiThemes, customData}
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences) :. (createdAt, updatedAt)) =
let memberProfile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
memberSettings = GroupMemberSettings {showMessages}
blockedByAdmin = maybe False mrsBlocked memberRestriction_
@ -615,7 +615,8 @@ groupInfoQuery =
-- 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,
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_id

View file

@ -784,7 +784,9 @@ data GroupMember = GroupMember
-- member chat protocol version range; if member has active connection, its version range is preferred;
-- for membership current supportedChatVRange is set, it's not updated on protocol version increase in database,
-- but it's correctly set on read (see toGroupInfo)
memberChatVRange :: VersionRangeChat
memberChatVRange :: VersionRangeChat,
createdAt :: UTCTime,
updatedAt :: UTCTime
}
deriving (Eq, Show)

View file

@ -87,6 +87,11 @@ mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup =
superUsers,
ownersGroup,
directoryLog = Just $ ps </> "directory_service.log",
blockedWordsFile = Nothing,
blockedExtensionRules = Nothing,
nameSpellingFile = Nothing,
profileNameLimit = maxBound,
acceptAsObserver = Nothing,
serviceName = "SimpleX-Directory",
runCLI = False,
searchResults = 3,

View file

@ -390,15 +390,15 @@ withTmpFiles =
(removeDirectoryRecursive "tests/tmp")
testChatN :: HasCallStack => ChatConfig -> ChatOpts -> [Profile] -> (HasCallStack => [TestCC] -> IO ()) -> TestParams -> IO ()
testChatN cfg opts ps test params = do
tcs <- getTestCCs (zip ps [1 ..]) []
test tcs
concurrentlyN_ $ map (<// 100000) tcs
concurrentlyN_ $ map (stopTestChat params) tcs
testChatN cfg opts ps test params =
bracket (getTestCCs (zip ps [1 ..]) []) entTests test
where
getTestCCs :: [(Profile, Int)] -> [TestCC] -> IO [TestCC]
getTestCCs [] tcs = pure tcs
getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat params cfg opts (show db) p <*> getTestCCs envs' tcs
entTests tcs = do
concurrentlyN_ $ map (<// 100000) tcs
concurrentlyN_ $ map (stopTestChat params) tcs
(<//) :: HasCallStack => TestCC -> Int -> Expectation
(<//) cc t = timeout t (getTermLine cc) `shouldReturn` Nothing