dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-08-28 00:44:27 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: group permision to allow files and media (#2610)

Browse Source 
* core: group permision to allow files and media

* test
This commit is contained in:
Evgeny Poberezkin
2023-06-24 12:36:07 +01:00
committed by GitHub
parent da2622f00e
commit 6da18d9b2a
7 changed files with 97 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+32 -27
View File
@@ -551,22 +551,25 @@ processChatCommand = \case
quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False)
quoteData _ = throwChatError CEInvalidQuote
CTGroup -> do
g@(Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms) <- withStore $ \db -> getGroup db user chatId
g@(Group gInfo _) <- withStore $ \db -> getGroup db user chatId
assertUserGroupRole gInfo GRAuthor
if isVoice mc && not (groupFeatureAllowed SGFVoice gInfo)
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText GFVoice))
else do
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
timed_ <- sndGroupCITimed live gInfo itemTTL
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
msg@SndMessage {sharedMsgId} <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
forM_ (timed_ >>= timedDeleteAt') $
startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci)
setActive $ ActiveG gName
pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
send g
where
send g@(Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms)
| isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) = notAllowedError GFVoice
| not (isVoice mc) && isJust file_ && not (groupFeatureAllowed SGFFiles gInfo) = notAllowedError GFFiles
| otherwise = do
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
timed_ <- sndGroupCITimed live gInfo itemTTL
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
msg@SndMessage {sharedMsgId} <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
forM_ (timed_ >>= timedDeleteAt') $
startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci)
setActive $ ActiveG gName
pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
notAllowedError f = pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText f))
setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
setupSndFileTransfer g@(Group gInfo _) n = forM file_ $ \file -> do
(fileSize, fileMode) <- checkSndFile mc file $ fromIntegral n
@@ -3533,20 +3536,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
e -> throwError e
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
newGroupContentMessage gInfo m@GroupMember {localDisplayName = c, memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
-- TODO integrity message check
if isVoice content && not (groupFeatureAllowed SGFVoice gInfo)
then void $ newChatItem (CIRcvGroupFeatureRejected GFVoice) Nothing Nothing False
else do
-- check if message moderation event was received ahead of message
let timed_ = rcvGroupCITimed gInfo itemTTL
live = fromMaybe False live_
withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
Just ciModeration -> do
applyModeration timed_ live ciModeration
withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
Nothing -> createItem timed_ live
newGroupContentMessage gInfo m@GroupMember {localDisplayName = c, memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} msgMeta
| isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
| not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
| otherwise = do
-- TODO integrity message check
-- check if message moderation event was received ahead of message
let timed_ = rcvGroupCITimed gInfo itemTTL
live = fromMaybe False live_
withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
Just ciModeration -> do
applyModeration timed_ live ciModeration
withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
Nothing -> createItem timed_ live
where
rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False
ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc
applyModeration timed_ live CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, createdByMsgId, moderatedAt}
| moderatorRole < GRAdmin || moderatorRole < memberRole =
@@ -5018,6 +5022,7 @@ chatCommandP =
"/set voice #" *> (SetGroupFeature (AGF SGFVoice) <$> displayName <*> (A.space *> strP)),
"/set voice @" *> (SetContactFeature (ACF SCFVoice) <$> displayName <*> optional (A.space *> strP)),
"/set voice " *> (SetUserFeature (ACF SCFVoice) <$> strP),
"/set files #" *> (SetGroupFeature (AGF SGFFiles) <$> displayName <*> (A.space *> strP)),
"/set calls @" *> (SetContactFeature (ACF SCFCalls) <$> displayName <*> optional (A.space *> strP)),
"/set calls " *> (SetUserFeature (ACF SCFCalls) <$> strP),
"/set delete #" *> (SetGroupFeature (AGF SGFFullDelete) <$> displayName <*> (A.space *> strP)),
src/Simplex/Chat/Help.hs
+1
View File
@@ -153,6 +153,7 @@ groupsHelpInfo =
"",
green "Group chat preferences:",
indent <> highlight "/set voice #<group> on/off " <> " - enable/disable voice messages",
-- indent <> highlight "/set files #<group> on/off " <> " - enable/disable files and media (other than voice)",
indent <> highlight "/set delete #<group> on/off " <> " - enable/disable full message deletion",
indent <> highlight "/set direct #<group> on/off " <> " - enable/disable direct messages to other members",
indent <> highlight "/set disappear #<group> on <time> " <> " - enable disappearing messages with <time>:",
src/Simplex/Chat/Types.hs
+35 -8
View File
@@ -488,6 +488,7 @@ data GroupFeature
| -- | GFReceipts
GFReactions
| GFVoice
| GFFiles
deriving (Show, Generic)
data SGroupFeature (f :: GroupFeature) where
@@ -497,6 +498,7 @@ data SGroupFeature (f :: GroupFeature) where
-- SGFReceipts :: SGroupFeature 'GFReceipts
SGFReactions :: SGroupFeature 'GFReactions
SGFVoice :: SGroupFeature 'GFVoice
SGFFiles :: SGroupFeature 'GFFiles
deriving instance Show (SGroupFeature f)
@@ -511,6 +513,7 @@ groupFeatureNameText = \case
GFFullDelete -> "Full deletion"
GFReactions -> "Message reactions"
GFVoice -> "Voice messages"
GFFiles -> "Files and media"
groupFeatureNameText' :: SGroupFeature f -> Text
groupFeatureNameText' = groupFeatureNameText . toGroupFeature
@@ -536,7 +539,8 @@ allGroupFeatures =
AGF SGFFullDelete,
-- GFReceipts,
AGF SGFReactions,
AGF SGFVoice
AGF SGFVoice,
AGF SGFFiles
]
groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
@@ -547,6 +551,7 @@ groupPrefSel = \case
-- GFReceipts -> receipts
SGFReactions -> reactions
SGFVoice -> voice
SGFFiles -> files
toGroupFeature :: SGroupFeature f -> GroupFeature
toGroupFeature = \case
@@ -555,6 +560,7 @@ toGroupFeature = \case
SGFFullDelete -> GFFullDelete
SGFReactions -> GFReactions
SGFVoice -> GFVoice
SGFFiles -> GFFiles
class GroupPreferenceI p where
getGroupPreference :: SGroupFeature f -> p -> GroupFeaturePreference f
@@ -573,6 +579,7 @@ instance GroupPreferenceI FullGroupPreferences where
-- GFReceipts -> receipts
SGFReactions -> reactions
SGFVoice -> voice
SGFFiles -> files
{-# INLINE getGroupPreference #-}
-- collection of optional group preferences
@@ -582,7 +589,8 @@ data GroupPreferences = GroupPreferences
fullDelete :: Maybe FullDeleteGroupPreference,
-- receipts :: Maybe GroupPreference,
reactions :: Maybe ReactionsGroupPreference,
voice :: Maybe VoiceGroupPreference
voice :: Maybe VoiceGroupPreference,
files :: Maybe FilesGroupPreference
}
deriving (Eq, Show, Generic, FromJSON)
@@ -613,9 +621,10 @@ setGroupPreference_ f pref prefs =
toGroupPreferences $ case f of
SGFTimedMessages -> prefs {timedMessages = pref}
SGFDirectMessages -> prefs {directMessages = pref}
SGFFullDelete -> prefs {fullDelete = pref}
SGFReactions -> prefs {reactions = pref}
SGFVoice -> prefs {voice = pref}
SGFFullDelete -> prefs {fullDelete = pref}
SGFFiles -> prefs {files = pref}
setGroupTimedMessagesPreference :: TimedMessagesGroupPreference -> Maybe GroupPreferences -> GroupPreferences
setGroupTimedMessagesPreference pref prefs_ =
@@ -645,7 +654,8 @@ data FullGroupPreferences = FullGroupPreferences
fullDelete :: FullDeleteGroupPreference,
-- receipts :: GroupPreference,
reactions :: ReactionsGroupPreference,
voice :: VoiceGroupPreference
voice :: VoiceGroupPreference,
files :: FilesGroupPreference
}
deriving (Eq, Show, Generic, FromJSON)
@@ -713,11 +723,12 @@ defaultGroupPrefs =
fullDelete = FullDeleteGroupPreference {enable = FEOff},
-- receipts = GroupPreference {enable = FEOff},
reactions = ReactionsGroupPreference {enable = FEOn},
voice = VoiceGroupPreference {enable = FEOn}
voice = VoiceGroupPreference {enable = FEOn},
files = FilesGroupPreference {enable = FEOn}
}
emptyGroupPrefs :: GroupPreferences
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing
data TimedMessagesPreference = TimedMessagesPreference
{ allow :: FeatureAllowed,
@@ -820,6 +831,10 @@ data VoiceGroupPreference = VoiceGroupPreference
{enable :: GroupFeatureEnabled}
deriving (Eq, Show, Generic, FromJSON)
data FilesGroupPreference = FilesGroupPreference
{enable :: GroupFeatureEnabled}
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON GroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
instance ToJSON TimedMessagesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
@@ -832,6 +847,8 @@ instance ToJSON FullDeleteGroupPreference where toEncoding = J.genericToEncoding
instance ToJSON VoiceGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
instance ToJSON FilesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference f) GroupFeatureEnabled) => GroupFeatureI f where
type GroupFeaturePreference (f :: GroupFeature) = p | p -> f
sGroupFeature :: SGroupFeature f
@@ -855,6 +872,9 @@ instance HasField "enable" FullDeleteGroupPreference GroupFeatureEnabled where
instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, enable (p :: VoiceGroupPreference))
instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, enable (p :: FilesGroupPreference))
instance GroupFeatureI 'GFTimedMessages where
type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
sGroupFeature = SGFTimedMessages
@@ -880,6 +900,11 @@ instance GroupFeatureI 'GFVoice where
sGroupFeature = SGFVoice
groupPrefParam _ = Nothing
instance GroupFeatureI 'GFFiles where
type GroupFeaturePreference 'GFFiles = FilesGroupPreference
sGroupFeature = SGFFiles
groupPrefParam _ = Nothing
groupPrefStateText :: HasField "enable" p GroupFeatureEnabled => GroupFeature -> p -> Maybe Int -> Text
groupPrefStateText feature pref param =
let enabled = getField @"enable" pref
@@ -1011,7 +1036,8 @@ mergeGroupPreferences groupPreferences =
fullDelete = pref SGFFullDelete,
-- receipts = pref GFReceipts,
reactions = pref SGFReactions,
voice = pref SGFVoice
voice = pref SGFVoice,
files = pref SGFFiles
}
where
pref :: SGroupFeature f -> GroupFeaturePreference f
@@ -1025,7 +1051,8 @@ toGroupPreferences groupPreferences =
fullDelete = pref SGFFullDelete,
-- receipts = pref GFReceipts,
reactions = pref SGFReactions,
voice = pref SGFVoice
voice = pref SGFVoice,
files = pref SGFFiles
}
where
pref :: SGroupFeature f -> Maybe (GroupFeaturePreference f)