mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
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:
parent
981901d587
commit
511ff1d35c
19 changed files with 267 additions and 36 deletions
|
@ -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
|
||||
|
|
64
apps/simplex-directory-service/src/Directory/BlockedWords.hs
Normal file
64
apps/simplex-directory-service/src/Directory/BlockedWords.hs
Normal 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)
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -112,6 +112,9 @@ defaultChatConfig =
|
|||
ntf = _defaultNtfServers,
|
||||
netCfg = defaultNetworkConfig
|
||||
},
|
||||
allowedProfileName = Nothing,
|
||||
profileNameLimit = maxBound,
|
||||
acceptAsObserver = Nothing,
|
||||
tbqSize = 1024,
|
||||
fileChunkSize = 15780, -- do not change
|
||||
xftpDescrPartSize = 14000,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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),
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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",
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue