core: block member for all (#3689)

* core: silence member wip

* change approach

* more types

* remove comment

* bool in protocol msg

* flag in items, event

* send event, process

* apply moderation

* remove comment

* filter for forward, view

* tests

* rename

* separate response, check already blocked

* add test

* fix terminal api

* add comment

* don't send profile update

* corrections

* refactor

* rework - flag blocked by admin

* blocked in intro

* fix test

* cant block unblock self

* muted view, create unknown member

* blocked by admin in members list

* create with maybe null

* protocol changes

* align code with protocol

* revert terminal api

* restrict block api for admins

* stabilize test

* rename

* update protocol/types

* refactor

* refactor2

* stabilize test

* member field

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>

simplex-chat.cabal

@@ -131,6 +131,7 @@ library
       Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries
       Simplex.Chat.Migrations.M20240102_note_folders
       Simplex.Chat.Migrations.M20240104_members_profile_update
+      Simplex.Chat.Migrations.M20240115_block_member_for_all
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared

src/Simplex/Chat.hs

@@ -1290,9 +1290,8 @@ processChatCommand' vr = \case
     m <- withStore $ \db -> do
       liftIO $ updateGroupMemberSettings db user gId gMemberId settings
       getGroupMember db user gId gMemberId
-    when (memberActive m) $ forM_ (memberConnId m) $ \connId -> do
-      let ntfOn = showMessages $ memberSettings m
-      withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CRChatError (Just user))
+    let ntfOn = showMessages $ memberSettings m
+    toggleNtf user m ntfOn
     ok user
   APIContactInfo contactId -> withUser $ \user@User {userId} -> do
     -- [incognito] print user's incognito profile for this contact
@@ -1410,7 +1409,10 @@ processChatCommand' vr = \case
   SetSendReceipts cName rcptsOn_ -> updateChatSettings cName (\cs -> cs {sendRcpts = rcptsOn_})
   SetShowMemberMessages gName mName showMessages -> withUser $ \user -> do
     (gId, mId) <- getGroupAndMemberId user gName mName
+    gInfo <- withStore $ \db -> getGroupInfo db vr user gId
     m <- withStore $ \db -> getGroupMember db user gId mId
+    let GroupInfo {membership = GroupMember {memberRole = membershipRole}} = gInfo
+    when (membershipRole >= GRAdmin) $ throwChatError $ CECantBlockMemberForSelf gInfo m showMessages
     let settings = (memberSettings m) {showMessages}
     processChatCommand $ APISetMemberSettings gId mId settings
   ContactInfo cName -> withContactName cName APIContactInfo
@@ -1721,6 +1723,31 @@ processChatCommand' vr = \case
                 ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent)
                 toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
           pure CRMemberRoleUser {user, groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole}
+  APIBlockMemberForAll groupId memberId blocked -> withUser $ \user -> do
+    Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db vr user groupId
+    when (memberId == groupMemberId' membership) $ throwChatError $ CECommandError "can't block/unblock self"
+    case splitMember memberId members of
+      Nothing -> throwChatError $ CEException "expected to find a single blocked member"
+      Just (bm, remainingMembers) -> do
+        let GroupMember {memberId = bmMemberId, memberRole = bmRole, memberProfile = bmp} = bm
+        assertUserGroupRole gInfo $ max GRAdmin bmRole
+        when (blocked == blockedByAdmin bm) $ throwChatError $ CECommandError $ if blocked then "already blocked" else "already unblocked"
+        withChatLock "blockForAll" . procCmd $ do
+          let mrs = if blocked then MRSBlocked else MRSUnrestricted
+              event = XGrpMemRestrict bmMemberId MemberRestrictions {restriction = mrs}
+          (msg, _) <- sendGroupMessage' user gInfo remainingMembers event
+          let ciContent = CISndGroupEvent $ SGEMemberBlocked memberId (fromLocalProfile bmp) blocked
+          ci <- saveSndChatItem user (CDGroupSnd gInfo) msg ciContent
+          toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
+          bm' <- withStore $ \db -> do
+            liftIO $ updateGroupMemberBlocked db user groupId memberId mrs
+            getGroupMember db user groupId memberId
+          toggleNtf user bm' (not blocked)
+          pure CRMemberBlockedForAllUser {user, groupInfo = gInfo, member = bm', blocked}
+    where
+      splitMember mId ms = case break ((== mId) . groupMemberId') ms of
+        (_, []) -> Nothing
+        (ms1, bm : ms2) -> Just (bm, ms1 <> ms2)
   APIRemoveMember groupId memberId -> withUser $ \user -> do
     Group gInfo members <- withStore $ \db -> getGroup db vr user groupId
     case find ((== memberId) . groupMemberId') members of
@@ -1761,6 +1788,7 @@ processChatCommand' vr = \case
     groupId <- withStore $ \db -> getGroupIdByName db user gName
     processChatCommand $ APIJoinGroup groupId
   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
   LeaveGroup gName -> withUser $ \user -> do
     groupId <- withStore $ \db -> getGroupIdByName db user gName
@@ -2487,6 +2515,12 @@ processChatCommand' vr = \case
         cReqHashes = bimap hash hash cReqSchemas
         hash = ConnReqUriHash . C.sha256Hash . strEncode
 
+toggleNtf :: ChatMonad m => User -> GroupMember -> Bool -> m ()
+toggleNtf user m ntfOn =
+  when (memberActive m) $
+    forM_ (memberConnId m) $ \connId ->
+      withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CRChatError (Just user))
+
 data ChangedProfileContact = ChangedProfileContact
   { ct :: Contact,
     ct' :: Contact,
@@ -3723,11 +3757,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                 shuffledIntros <- liftIO $ shuffleIntros intros
                 if isCompatibleRange (memberChatVRange' m) batchSendVRange
                   then do
-                    let events = map (XGrpMemIntro . memberInfo . reMember) shuffledIntros
+                    let events = map (memberIntro . reMember) shuffledIntros
                     forM_ (L.nonEmpty events) $ \events' ->
                       sendGroupMemberMessages user conn events' groupId
                   else forM_ shuffledIntros $ \intro ->
                     processIntro intro `catchChatError` (toView . CRChatError (Just user))
+              memberIntro :: GroupMember -> ChatMsgEvent 'Json
+              memberIntro reMember =
+                let mInfo = memberInfo reMember
+                    mRestrictions = memberRestrictions reMember
+                 in XGrpMemIntro mInfo mRestrictions
               shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro]
               shuffleIntros intros = do
                 let (admins, others) = partition isAdmin intros
@@ -3738,7 +3777,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                   isAdmin GroupMemberIntro {reMember = GroupMember {memberRole}} = memberRole >= GRAdmin
                   hasPicture GroupMemberIntro {reMember = GroupMember {memberProfile = LocalProfile {image}}} = isJust image
               processIntro intro@GroupMemberIntro {introId} = do
-                void $ sendDirectMessage conn (XGrpMemIntro $ memberInfo (reMember intro)) (GroupId groupId)
+                void $ sendDirectMessage conn (memberIntro $ reMember intro) (GroupId groupId)
                 withStore' $ \db -> updateIntroStatus db introId GMIntroSent
               sendHistory =
                 when (isCompatibleRange (memberChatVRange' m) batchSendVRange) $ do
@@ -3757,9 +3796,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                 | otherwise = Nothing
               itemForwardEvents :: CChatItem 'CTGroup -> m [ChatMsgEvent 'Json]
               itemForwardEvents cci = case cci of
-                (CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file}) -> do
-                  fInvDescr_ <- join <$> forM file getRcvFileInvDescr
-                  processContentItem sender ci mc fInvDescr_
+                (CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file})
+                  | not (blockedByAdmin sender) -> do
+                      fInvDescr_ <- join <$> forM file getRcvFileInvDescr
+                      processContentItem sender ci mc fInvDescr_
                 (CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do
                   fInvDescr_ <- join <$> forM file getSndFileInvDescr
                   processContentItem membership ci mc fInvDescr_
@@ -3855,7 +3895,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           checkSendRcpt $ rights aChatMsgs
         -- currently only a single message is forwarded
         let GroupMember {memberRole = membershipMemRole} = membership
-        when (membershipMemRole >= GRAdmin) $ case aChatMsgs of
+        when (membershipMemRole >= GRAdmin && not (blockedByAdmin m)) $ case aChatMsgs of
           [Right (ACMsg _ chatMsg)] -> forwardMsg_ chatMsg
           _ -> pure ()
         where
@@ -3877,10 +3917,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               XInfo p -> xInfoMember gInfo m' p
               XGrpLinkMem p -> xGrpLinkMem gInfo m' conn' p
               XGrpMemNew memInfo -> xGrpMemNew gInfo m' memInfo msg brokerTs
-              XGrpMemIntro memInfo -> xGrpMemIntro gInfo m' memInfo
+              XGrpMemIntro memInfo memRestrictions_ -> xGrpMemIntro gInfo m' memInfo memRestrictions_
               XGrpMemInv memId introInv -> xGrpMemInv gInfo m' memId introInv
               XGrpMemFwd memInfo introInv -> xGrpMemFwd gInfo m' memInfo introInv
               XGrpMemRole memId memRole -> xGrpMemRole gInfo m' memId memRole msg brokerTs
+              XGrpMemRestrict memId memRestrictions -> xGrpMemRestrict gInfo m' memId memRestrictions msg brokerTs
               XGrpMemCon memId -> xGrpMemCon gInfo m' memId
               XGrpMemDel memId -> xGrpMemDel gInfo m' memId msg brokerTs
               XGrpLeave -> xGrpLeave gInfo m' msg brokerTs
@@ -3916,7 +3957,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               -- invited members to which this member was introduced
               invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db user m highlyAvailable
               let GroupMember {memberId} = m
-                  ms = introducedMembers <> invitedMembers
+                  ms = forwardedToGroupMembers (introducedMembers <> invitedMembers) chatMsg'
                   msg = XGrpMsgForward memberId chatMsg' brokerTs
               unless (null ms) . void $
                 sendGroupMessage' user gInfo ms msg
@@ -4506,37 +4547,49 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
 
     newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> Bool -> m ()
     newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs forwarded
+      | blockedByAdmin m = createBlockedByAdmin
       | isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
       | not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
-      | otherwise = do
-          let timed_ =
-                if forwarded
-                  then rcvCITimed_ (Just Nothing) itemTTL
-                  else rcvGroupCITimed gInfo itemTTL
-              live = fromMaybe False live_
+      | otherwise =
           withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
             Just ciModeration -> do
-              applyModeration timed_ live ciModeration
+              applyModeration ciModeration
               withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
-            Nothing -> createItem timed_ live
+            Nothing -> createContentItem
       where
         rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False
+        timed' = if forwarded then rcvCITimed_ (Just Nothing) itemTTL else rcvGroupCITimed gInfo itemTTL
+        live' = fromMaybe False live_
         ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc
-        applyModeration timed_ live CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, createdByMsgId, moderatedAt}
-          | moderatorRole < GRAdmin || moderatorRole < memberRole =
-              createItem timed_ live
+        createBlockedByAdmin
           | groupFeatureAllowed SGFFullDelete gInfo = do
-              ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed_ False
-              ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt
-              toView $ CRNewChatItem user $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci'
+              ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvBlocked Nothing timed' False
+              ci' <- withStore' $ \db -> updateGroupCIBlockedByAdmin db user gInfo ci brokerTs
+              groupMsgToView gInfo ci'
           | otherwise = do
-              file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
-              ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content) (snd <$> file_) timed_ False
+              file_ <- processFileInv
+              ci <- createNonLive file_
+              ci' <- withStore' $ \db -> markGroupCIBlockedByAdmin db user gInfo ci
+              groupMsgToView gInfo ci'
+        applyModeration CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, createdByMsgId, moderatedAt}
+          | moderatorRole < GRAdmin || moderatorRole < memberRole =
+              createContentItem
+          | groupFeatureAllowed SGFFullDelete gInfo = do
+              ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed' False
+              ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt
+              groupMsgToView gInfo ci'
+          | otherwise = do
+              file_ <- processFileInv
+              ci <- createNonLive file_
               toView =<< markGroupCIDeleted user gInfo ci createdByMsgId False (Just moderator) moderatedAt
-        createItem timed_ live = do
-          file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
-          newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live
+        createNonLive file_ =
+          saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content) (snd <$> file_) timed' False
+        createContentItem = do
+          file_ <- processFileInv
+          newChatItem (CIRcvMsgContent content) (snd <$> file_) timed' live'
           when (showMessages $ memberSettings m) $ autoAcceptFile file_
+        processFileInv =
+          processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
         newChatItem ciContent ciFile_ timed_ live = do
           ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live
           ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci
@@ -5226,8 +5279,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           groupMsgToView gInfo ci
           toView $ CRJoinedGroupMemberConnecting user gInfo m announcedMember
 
-    xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> m ()
-    xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) = do
+    xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> m ()
+    xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) memRestrictions = do
       case memberCategory m of
         GCHostMember ->
           withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case
@@ -5243,7 +5296,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                   | isCompatibleRange (fromChatVRange mcvr) groupNoDirectVRange -> pure Nothing
                   | otherwise -> Just <$> createConn subMode
               let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
-              void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnIds directConnIds customUserProfileId subMode
+              void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo memRestrictions groupConnIds directConnIds customUserProfileId subMode
         _ -> messageError "x.grp.mem.intro can be only sent by host member"
       where
         createConn subMode = createAgentConnectionAsync user CFCreateConnGrpMemInv (chatHasNtfs chatSettings) SCMInvitation subMode
@@ -5315,6 +5368,40 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
     checkHostRole GroupMember {memberRole, localDisplayName} memRole =
       when (memberRole < GRAdmin || memberRole < memRole) $ throwChatError (CEGroupContactRole localDisplayName)
 
+    xGrpMemRestrict :: GroupInfo -> GroupMember -> MemberId -> MemberRestrictions -> RcvMessage -> UTCTime -> m ()
+    xGrpMemRestrict
+      gInfo@GroupInfo {groupId, membership = GroupMember {memberId = membershipMemId}}
+      m@GroupMember {memberRole = senderRole}
+      memId
+      MemberRestrictions {restriction}
+      msg
+      brokerTs
+        | membershipMemId == memId =
+            -- member shouldn't receive this message about themselves
+            messageError "x.grp.mem.restrict: admin blocks you"
+        | otherwise =
+            withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case
+              Right bm@GroupMember {groupMemberId = bmId, memberRole, memberProfile = bmp}
+                | senderRole < GRAdmin || senderRole < memberRole -> messageError "x.grp.mem.restrict with insufficient member permissions"
+                | otherwise -> do
+                    bm' <- setMemberBlocked bmId
+                    toggleNtf user bm' (not blocked)
+                    let ciContent = CIRcvGroupEvent $ RGEMemberBlocked bmId (fromLocalProfile bmp) blocked
+                    ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs ciContent
+                    groupMsgToView gInfo ci
+                    toView CRMemberBlockedForAll {user, groupInfo = gInfo, byMember = m, member = bm, blocked}
+              Left (SEGroupMemberNotFoundByMemberId _) -> do
+                bm <- createUnknownMember gInfo memId
+                bm' <- setMemberBlocked $ groupMemberId' bm
+                toView $ CRUnknownMemberBlocked user gInfo m bm'
+              Left e -> throwError $ ChatErrorStore e
+        where
+          setMemberBlocked bmId =
+            withStore $ \db -> do
+              liftIO $ updateGroupMemberBlocked db user groupId bmId restriction
+              getGroupMember db user groupId bmId
+          blocked = mrsBlocked restriction
+
     xGrpMemCon :: GroupInfo -> GroupMember -> MemberId -> m ()
     xGrpMemCon gInfo sendingMember memId = do
       refMember <- withStore $ \db -> getGroupMemberByMemberId db user gInfo memId
@@ -5474,8 +5561,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
       withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memberId) >>= \case
         Right author -> processForwardedMsg author msg
         Left (SEGroupMemberNotFoundByMemberId _) -> do
-          let name = T.take 7 . safeDecodeUtf8 . B64.encode . unMemberId $ memberId
-          unknownAuthor <- withStore $ \db -> createNewUnknownGroupMember db vr user gInfo memberId name
+          unknownAuthor <- createUnknownMember gInfo memberId
           toView $ CRUnknownMemberCreated user gInfo m unknownAuthor
           processForwardedMsg unknownAuthor msg
         Left e -> throwError $ ChatErrorStore e
@@ -5501,6 +5587,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             XGrpInfo p' -> xGrpInfo gInfo author p' rcvMsg msgTs
             _ -> messageError $ "x.grp.msg.forward: unsupported forwarded event " <> T.pack (show $ toCMEventTag event)
 
+    createUnknownMember :: GroupInfo -> MemberId -> m GroupMember
+    createUnknownMember gInfo memberId = do
+      let name = T.take 7 . safeDecodeUtf8 . B64.encode . unMemberId $ memberId
+      withStore $ \db -> createNewUnknownGroupMember db vr user gInfo memberId name
+
     directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
     directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do
       checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
@@ -6437,6 +6528,7 @@ chatCommandP =
       "/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
       "/_join #" *> (APIJoinGroup <$> A.decimal),
       "/_member role #" *> (APIMemberRole <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
+      "/_block #" *> (APIBlockMemberForAll <$> A.decimal <* A.space <*> A.decimal <* A.space <* "blocked=" <*> onOffP),
       "/_remove #" *> (APIRemoveMember <$> A.decimal <* A.space <*> A.decimal),
       "/_leave #" *> (APILeaveGroup <$> A.decimal),
       "/_members #" *> (APIListMembers <$> A.decimal),
@@ -6506,6 +6598,8 @@ chatCommandP =
       ("/add " <|> "/a ") *> char_ '#' *> (AddMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> (memberRole <|> pure GRMember)),
       ("/join " <|> "/j ") *> char_ '#' *> (JoinGroup <$> displayName),
       ("/member role " <|> "/mr ") *> char_ '#' *> (MemberRole <$> displayName <* A.space <* char_ '@' <*> displayName <*> memberRole),
+      "/block for all #" *> (BlockForAll <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure True),
+      "/unblock for all #" *> (BlockForAll <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure False),
       ("/remove " <|> "/rm ") *> char_ '#' *> (RemoveMember <$> displayName <* A.space <* char_ '@' <*> displayName),
       ("/leave " <|> "/l ") *> char_ '#' *> (LeaveGroup <$> displayName),
       ("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName),

src/Simplex/Chat/Controller.hs

@@ -294,6 +294,7 @@ data ChatCommand
   | APIAddMember GroupId ContactId GroupMemberRole
   | APIJoinGroup GroupId
   | APIMemberRole GroupId GroupMemberId GroupMemberRole
+  | APIBlockMemberForAll GroupId GroupMemberId Bool
   | APIRemoveMember GroupId GroupMemberId
   | APILeaveGroup GroupId
   | APIListMembers GroupId
@@ -393,6 +394,7 @@ data ChatCommand
   | AddMember GroupName ContactName GroupMemberRole
   | JoinGroup GroupName
   | MemberRole GroupName ContactName GroupMemberRole
+  | BlockForAll GroupName ContactName Bool
   | RemoveMember GroupName ContactName
   | LeaveGroup GroupName
   | DeleteGroup GroupName
@@ -630,11 +632,14 @@ data ChatResponse
   | CRJoinedGroupMemberConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
   | CRMemberRole {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
   | CRMemberRoleUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
+  | CRMemberBlockedForAll {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, blocked :: Bool}
+  | CRMemberBlockedForAllUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, blocked :: Bool}
   | CRConnectedToGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, memberContact :: Maybe Contact}
   | CRDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember}
   | CRDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
   | CRLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
   | CRUnknownMemberCreated {user :: User, groupInfo :: GroupInfo, forwardedByMember :: GroupMember, member :: GroupMember}
+  | CRUnknownMemberBlocked {user :: User, groupInfo :: GroupInfo, blockedByMember :: GroupMember, member :: GroupMember}
   | CRUnknownMemberAnnounced {user :: User, groupInfo :: GroupInfo, announcingMember :: GroupMember, unknownMember :: GroupMember, announcedMember :: GroupMember}
   | CRGroupEmpty {user :: User, groupInfo :: GroupInfo}
   | CRGroupRemoved {user :: User, groupInfo :: GroupInfo}
@@ -1053,6 +1058,7 @@ data ChatErrorType
   | CEGroupDuplicateMemberId
   | CEGroupNotJoined {groupInfo :: GroupInfo}
   | CEGroupMemberNotActive
+  | CECantBlockMemberForSelf {groupInfo :: GroupInfo, member :: GroupMember, setShowMessages :: Bool}
   | CEGroupMemberUserRemoved
   | CEGroupMemberNotFound
   | CEGroupMemberIntroNotFound {contactName :: ContactName}

src/Simplex/Chat/Messages.hs

@@ -929,6 +929,7 @@ msgDeliveryStatusT' s =
 data CIDeleted (c :: ChatType) where
   CIDeleted :: Maybe UTCTime -> CIDeleted c
   CIBlocked :: Maybe UTCTime -> CIDeleted 'CTGroup
+  CIBlockedByAdmin :: Maybe UTCTime -> CIDeleted 'CTGroup
   CIModerated :: Maybe UTCTime -> GroupMember -> CIDeleted 'CTGroup
 
 deriving instance Show (CIDeleted c)
@@ -938,6 +939,7 @@ data ACIDeleted = forall c. ChatTypeI c => ACIDeleted (SChatType c) (CIDeleted c
 data JSONCIDeleted
   = JCIDDeleted {deletedTs :: Maybe UTCTime, chatType :: ChatType}
   | JCIDBlocked {deletedTs :: Maybe UTCTime}
+  | JCIBlockedByAdmin {deletedTs :: Maybe UTCTime}
   | JCIDModerated {deletedTs :: Maybe UTCTime, byGroupMember :: GroupMember}
   deriving (Show)
 
@@ -945,18 +947,21 @@ jsonCIDeleted :: forall d. ChatTypeI d => CIDeleted d -> JSONCIDeleted
 jsonCIDeleted = \case
   CIDeleted ts -> JCIDDeleted ts (toChatType $ chatTypeI @d)
   CIBlocked ts -> JCIDBlocked ts
+  CIBlockedByAdmin ts -> JCIBlockedByAdmin ts
   CIModerated ts m -> JCIDModerated ts m
 
 jsonACIDeleted :: JSONCIDeleted -> ACIDeleted
 jsonACIDeleted = \case
   JCIDDeleted ts cType -> case aChatType cType of ACT c -> ACIDeleted c $ CIDeleted ts
   JCIDBlocked ts -> ACIDeleted SCTGroup $ CIBlocked ts
+  JCIBlockedByAdmin ts -> ACIDeleted SCTGroup $ CIBlockedByAdmin ts
   JCIDModerated ts m -> ACIDeleted SCTGroup (CIModerated ts m)
 
 itemDeletedTs :: CIDeleted d -> Maybe UTCTime
 itemDeletedTs = \case
   CIDeleted ts -> ts
   CIBlocked ts -> ts
+  CIBlockedByAdmin ts -> ts
   CIModerated ts _ -> ts
 
 data ChatItemInfo = ChatItemInfo

src/Simplex/Chat/Messages/CIContent.hs

@@ -138,6 +138,7 @@ data CIContent (d :: MsgDirection) where
   CIRcvGroupFeatureRejected :: GroupFeature -> CIContent 'MDRcv
   CISndModerated :: CIContent 'MDSnd
   CIRcvModerated :: CIContent 'MDRcv
+  CIRcvBlocked :: CIContent 'MDRcv
   CIInvalidJSON :: Text -> CIContent d
 -- ^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API
 -- ! ^ Nested sum types also have to use different encodings for database and API
@@ -177,6 +178,7 @@ ciRequiresAttention content = case msgDirection @d of
       RGEMemberConnected -> False
       RGEMemberLeft -> False
       RGEMemberRole {} -> False
+      RGEMemberBlocked {} -> False
       RGEUserRole _ -> True
       RGEMemberDeleted {} -> False
       RGEUserDeleted -> True
@@ -192,6 +194,7 @@ ciRequiresAttention content = case msgDirection @d of
     CIRcvChatFeatureRejected _ -> True
     CIRcvGroupFeatureRejected _ -> True
     CIRcvModerated -> True
+    CIRcvBlocked -> False
     CIInvalidJSON _ -> False
 
 newtype DBMsgErrorType = DBME MsgErrorType
@@ -246,6 +249,7 @@ ciContentToText = \case
   CIRcvGroupFeatureRejected feature -> groupFeatureNameText feature <> ": received, prohibited"
   CISndModerated -> ciModeratedText
   CIRcvModerated -> ciModeratedText
+  CIRcvBlocked -> "blocked"
   CIInvalidJSON _ -> "invalid content JSON"
 
 ciGroupInvitationToText :: CIGroupInvitation -> GroupMemberRole -> Text
@@ -263,6 +267,7 @@ rcvGroupEventToText = \case
   RGEMemberConnected -> "connected"
   RGEMemberLeft -> "left"
   RGEMemberRole _ p r -> "changed role of " <> profileToText p <> " to " <> safeDecodeUtf8 (strEncode r)
+  RGEMemberBlocked _ p blocked -> (if blocked then "blocked" else "unblocked") <> " " <> profileToText p
   RGEUserRole r -> "changed your role to " <> safeDecodeUtf8 (strEncode r)
   RGEMemberDeleted _ p -> "removed " <> profileToText p
   RGEUserDeleted -> "removed you"
@@ -275,6 +280,7 @@ rcvGroupEventToText = \case
 sndGroupEventToText :: SndGroupEvent -> Text
 sndGroupEventToText = \case
   SGEMemberRole _ p r -> "changed role of " <> profileToText p <> " to " <> safeDecodeUtf8 (strEncode r)
+  SGEMemberBlocked _ p blocked -> (if blocked then "blocked" else "unblocked") <> " " <> profileToText p
   SGEUserRole r -> "changed role for yourself to " <> safeDecodeUtf8 (strEncode r)
   SGEMemberDeleted _ p -> "removed " <> profileToText p
   SGEUserLeft -> "left"
@@ -375,6 +381,7 @@ data JSONCIContent
   | JCIRcvGroupFeatureRejected {groupFeature :: GroupFeature}
   | JCISndModerated
   | JCIRcvModerated
+  | JCIRcvBlocked
   | JCIInvalidJSON {direction :: MsgDirection, json :: Text}
 
 jsonCIContent :: forall d. MsgDirectionI d => CIContent d -> JSONCIContent
@@ -404,6 +411,7 @@ jsonCIContent = \case
   CIRcvGroupFeatureRejected groupFeature -> JCIRcvGroupFeatureRejected {groupFeature}
   CISndModerated -> JCISndModerated
   CIRcvModerated -> JCIRcvModerated
+  CIRcvBlocked -> JCIRcvBlocked
   CIInvalidJSON json -> JCIInvalidJSON (toMsgDirection $ msgDirection @d) json
 
 aciContentJSON :: JSONCIContent -> ACIContent
@@ -433,6 +441,7 @@ aciContentJSON = \case
   JCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature
   JCISndModerated -> ACIContent SMDSnd CISndModerated
   JCIRcvModerated -> ACIContent SMDRcv CIRcvModerated
+  JCIRcvBlocked -> ACIContent SMDRcv CIRcvBlocked
   JCIInvalidJSON dir json -> case fromMsgDirection dir of
     AMsgDirection d -> ACIContent d $ CIInvalidJSON json
 
@@ -463,6 +472,7 @@ data DBJSONCIContent
   | DBJCIRcvGroupFeatureRejected {groupFeature :: GroupFeature}
   | DBJCISndModerated
   | DBJCIRcvModerated
+  | DBJCIRcvBlocked
   | DBJCIInvalidJSON {direction :: MsgDirection, json :: Text}
 
 dbJsonCIContent :: forall d. MsgDirectionI d => CIContent d -> DBJSONCIContent
@@ -492,6 +502,7 @@ dbJsonCIContent = \case
   CIRcvGroupFeatureRejected groupFeature -> DBJCIRcvGroupFeatureRejected {groupFeature}
   CISndModerated -> DBJCISndModerated
   CIRcvModerated -> DBJCIRcvModerated
+  CIRcvBlocked -> DBJCIRcvBlocked
   CIInvalidJSON json -> DBJCIInvalidJSON (toMsgDirection $ msgDirection @d) json
 
 aciContentDBJSON :: DBJSONCIContent -> ACIContent
@@ -521,6 +532,7 @@ aciContentDBJSON = \case
   DBJCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature
   DBJCISndModerated -> ACIContent SMDSnd CISndModerated
   DBJCIRcvModerated -> ACIContent SMDRcv CIRcvModerated
+  DBJCIRcvBlocked -> ACIContent SMDRcv CIRcvBlocked
   DBJCIInvalidJSON dir json -> case fromMsgDirection dir of
     AMsgDirection d -> ACIContent d $ CIInvalidJSON json
 
@@ -613,4 +625,5 @@ toCIContentTag ciContent = case ciContent of
   CIRcvGroupFeatureRejected _ -> "rcvGroupFeatureRejected"
   CISndModerated -> "sndModerated"
   CIRcvModerated -> "rcvModerated"
+  CIRcvBlocked -> "rcvBlocked"
   CIInvalidJSON _ -> "invalidJSON"

src/Simplex/Chat/Messages/CIContent/Events.hs

@@ -15,6 +15,7 @@ data RcvGroupEvent
   | RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember
   | RGEMemberLeft -- CRLeftMember
   | RGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
+  | RGEMemberBlocked {groupMemberId :: GroupMemberId, profile :: Profile, blocked :: Bool} -- CRMemberBlockedForAll
   | RGEUserRole {role :: GroupMemberRole}
   | RGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRDeletedMember
   | RGEUserDeleted -- CRDeletedMemberUser
@@ -30,6 +31,7 @@ data RcvGroupEvent
 
 data SndGroupEvent
   = SGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
+  | SGEMemberBlocked {groupMemberId :: GroupMemberId, profile :: Profile, blocked :: Bool} -- CRMemberBlockedForAllUser
   | SGEUserRole {role :: GroupMemberRole}
   | SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember
   | SGEUserLeft -- CRLeftMemberUser

src/Simplex/Chat/Migrations/M20240115_block_member_for_all.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20240115_block_member_for_all where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20240115_block_member_for_all :: Query
+m20240115_block_member_for_all =
+  [sql|
+ALTER TABLE group_members ADD COLUMN member_restriction TEXT;
+|]
+
+down_m20240115_block_member_for_all :: Query
+down_m20240115_block_member_for_all =
+  [sql|
+ALTER TABLE group_members DROP COLUMN member_restriction;
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -152,6 +152,7 @@ CREATE TABLE group_members(
   invited_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
   peer_chat_min_version INTEGER NOT NULL DEFAULT 1,
   peer_chat_max_version INTEGER NOT NULL DEFAULT 1,
+  member_restriction TEXT,
   FOREIGN KEY(user_id, local_display_name)
   REFERENCES display_names(user_id, local_display_name)
   ON DELETE CASCADE

src/Simplex/Chat/Protocol.hs

@@ -244,11 +244,12 @@ data ChatMsgEvent (e :: MsgEncoding) where
   XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json
   XGrpLinkMem :: Profile -> ChatMsgEvent 'Json
   XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json
-  XGrpMemIntro :: MemberInfo -> ChatMsgEvent 'Json
+  XGrpMemIntro :: MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json
   XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json
   XGrpMemFwd :: MemberInfo -> IntroInvitation -> ChatMsgEvent 'Json
   XGrpMemInfo :: MemberId -> Profile -> ChatMsgEvent 'Json
   XGrpMemRole :: MemberId -> GroupMemberRole -> ChatMsgEvent 'Json
+  XGrpMemRestrict :: MemberId -> MemberRestrictions -> ChatMsgEvent 'Json
   XGrpMemCon :: MemberId -> ChatMsgEvent 'Json
   XGrpMemConAll :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented
   XGrpMemDel :: MemberId -> ChatMsgEvent 'Json
@@ -290,6 +291,7 @@ isForwardedGroupMsg ev = case ev of
   XInfo _ -> True
   XGrpMemNew _ -> True
   XGrpMemRole {} -> True
+  XGrpMemRestrict {} -> True
   XGrpMemDel _ -> True -- TODO there should be a special logic when deleting host member (e.g., host forwards it before deleting connections)
   XGrpLeave -> True
   XGrpDel -> True -- TODO there should be a special logic - host should forward before deleting connections
@@ -301,6 +303,14 @@ forwardedGroupMsg msg@ChatMessage {chatMsgEvent} = case encoding @e of
   SJson | isForwardedGroupMsg chatMsgEvent -> Just msg
   _ -> Nothing
 
+-- applied after checking forwardedGroupMsg and building list of group members to forward to, see Chat
+forwardedToGroupMembers :: forall e. MsgEncodingI e => [GroupMember] -> ChatMessage e -> [GroupMember]
+forwardedToGroupMembers ms ChatMessage {chatMsgEvent} = case encoding @e of
+  SJson -> case chatMsgEvent of
+    XGrpMemRestrict mId _ -> filter (\GroupMember {memberId} -> memberId /= mId) ms
+    _ -> ms
+  _ -> []
+
 data MsgReaction = MREmoji {emoji :: MREmojiChar} | MRUnknown {tag :: Text, json :: J.Object}
   deriving (Eq, Show)
 
@@ -629,6 +639,7 @@ data CMEventTag (e :: MsgEncoding) where
   XGrpMemFwd_ :: CMEventTag 'Json
   XGrpMemInfo_ :: CMEventTag 'Json
   XGrpMemRole_ :: CMEventTag 'Json
+  XGrpMemRestrict_ :: CMEventTag 'Json
   XGrpMemCon_ :: CMEventTag 'Json
   XGrpMemConAll_ :: CMEventTag 'Json
   XGrpMemDel_ :: CMEventTag 'Json
@@ -678,6 +689,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
     XGrpMemFwd_ -> "x.grp.mem.fwd"
     XGrpMemInfo_ -> "x.grp.mem.info"
     XGrpMemRole_ -> "x.grp.mem.role"
+    XGrpMemRestrict_ -> "x.grp.mem.restrict"
     XGrpMemCon_ -> "x.grp.mem.con"
     XGrpMemConAll_ -> "x.grp.mem.con.all"
     XGrpMemDel_ -> "x.grp.mem.del"
@@ -728,6 +740,7 @@ instance StrEncoding ACMEventTag where
         "x.grp.mem.fwd" -> XGrpMemFwd_
         "x.grp.mem.info" -> XGrpMemInfo_
         "x.grp.mem.role" -> XGrpMemRole_
+        "x.grp.mem.restrict" -> XGrpMemRestrict_
         "x.grp.mem.con" -> XGrpMemCon_
         "x.grp.mem.con.all" -> XGrpMemConAll_
         "x.grp.mem.del" -> XGrpMemDel_
@@ -769,11 +782,12 @@ toCMEventTag msg = case msg of
   XGrpLinkInv _ -> XGrpLinkInv_
   XGrpLinkMem _ -> XGrpLinkMem_
   XGrpMemNew _ -> XGrpMemNew_
-  XGrpMemIntro _ -> XGrpMemIntro_
+  XGrpMemIntro _ _ -> XGrpMemIntro_
   XGrpMemInv _ _ -> XGrpMemInv_
   XGrpMemFwd _ _ -> XGrpMemFwd_
   XGrpMemInfo _ _ -> XGrpMemInfo_
   XGrpMemRole _ _ -> XGrpMemRole_
+  XGrpMemRestrict _ _ -> XGrpMemRestrict_
   XGrpMemCon _ -> XGrpMemCon_
   XGrpMemConAll _ -> XGrpMemConAll_
   XGrpMemDel _ -> XGrpMemDel_
@@ -868,11 +882,12 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
       XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation"
       XGrpLinkMem_ -> XGrpLinkMem <$> p "profile"
       XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
-      XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo"
+      XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo" <*> opt "memberRestrictions"
       XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
       XGrpMemFwd_ -> XGrpMemFwd <$> p "memberInfo" <*> p "memberIntro"
       XGrpMemInfo_ -> XGrpMemInfo <$> p "memberId" <*> p "profile"
       XGrpMemRole_ -> XGrpMemRole <$> p "memberId" <*> p "role"
+      XGrpMemRestrict_ -> XGrpMemRestrict <$> p "memberId" <*> p "memberRestrictions"
       XGrpMemCon_ -> XGrpMemCon <$> p "memberId"
       XGrpMemConAll_ -> XGrpMemConAll <$> p "memberId"
       XGrpMemDel_ -> XGrpMemDel <$> p "memberId"
@@ -928,11 +943,12 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
       XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv]
       XGrpLinkMem profile -> o ["profile" .= profile]
       XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]
-      XGrpMemIntro memInfo -> o ["memberInfo" .= memInfo]
+      XGrpMemIntro memInfo memRestrictions -> o $ ("memberRestrictions" .=? memRestrictions) ["memberInfo" .= memInfo]
       XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]
       XGrpMemFwd memInfo memIntro -> o ["memberInfo" .= memInfo, "memberIntro" .= memIntro]
       XGrpMemInfo memId profile -> o ["memberId" .= memId, "profile" .= profile]
       XGrpMemRole memId role -> o ["memberId" .= memId, "role" .= role]
+      XGrpMemRestrict memId memRestrictions -> o ["memberId" .= memId, "memberRestrictions" .= memRestrictions]
       XGrpMemCon memId -> o ["memberId" .= memId]
       XGrpMemConAll memId -> o ["memberId" .= memId]
       XGrpMemDel memId -> o ["memberId" .= memId]

src/Simplex/Chat/Store/Connections.hs

@@ -101,11 +101,11 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
               g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
               -- GroupInfo {membership}
               mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
-              mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
+              mu.member_status, mu.show_messages, mu.member_restriction, mu.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,
               -- 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.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
             FROM group_members m
             JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)

src/Simplex/Chat/Store/Groups.hs

@@ -98,6 +98,7 @@ module Simplex.Chat.Store.Groups
     deleteOldProbes,
     updateGroupSettings,
     updateGroupMemberSettings,
+    updateGroupMemberBlocked,
     getXGrpMemIntroContDirect,
     getXGrpMemIntroContGroup,
     getHostConnId,
@@ -147,9 +148,9 @@ import UnliftIO.STM
 
 type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. GroupMemberRow
 
-type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
+type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
 
-type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool) :. (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 Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, 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))
 
 toGroupInfo :: VersionRange -> Int64 -> GroupInfoRow -> GroupInfo
 toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. userMemberRow) =
@@ -160,17 +161,18 @@ toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName,
    in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt}
 
 toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
-toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
+toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
   let memberProfile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
       memberSettings = GroupMemberSettings {showMessages}
+      blockedByAdmin = maybe False mrsBlocked memberRestriction_
       invitedBy = toInvitedBy userContactId invitedById
       activeConn = Nothing
       memberChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
    in GroupMember {..}
 
 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) :. (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) :. (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 $ 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 _ _ = Nothing
 
 createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO ()
@@ -268,11 +270,11 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
           g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
           -- GroupInfo {membership}
           mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
-          mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
+          mu.member_status, mu.show_messages, mu.member_restriction, mu.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,
           -- 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.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,
           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.auth_err_counter,
@@ -429,6 +431,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
         memberCategory,
         memberStatus,
         memberSettings = defaultMemberSettings,
+        blockedByAdmin = False,
         invitedBy,
         invitedByGroupMemberId,
         localDisplayName,
@@ -615,7 +618,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
           g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
           g.host_conn_custom_user_profile_id, 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,
-          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.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
         FROM groups g
         JOIN group_profiles gp USING (group_profile_id)
@@ -678,7 +681,7 @@ groupMemberQuery :: Query
 groupMemberQuery =
   [sql|
     SELECT
-      m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages,
+      m.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,
       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.auth_err_counter,
@@ -797,6 +800,7 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId,
             memberCategory = GCInviteeMember,
             memberStatus = GSMemInvited,
             memberSettings = defaultMemberSettings,
+            blockedByAdmin = False,
             invitedBy = IBUser,
             invitedByGroupMemberId = Just invitedByGroupMemberId,
             localDisplayName,
@@ -954,6 +958,7 @@ createNewGroupMember db user gInfo invitingMember memInfo@MemberInfo {profile} m
           { memInfo,
             memCategory,
             memStatus,
+            memRestriction = Nothing,
             memInvitedBy = IBUnknown,
             memInvitedByGroupMemberId = Just $ groupMemberId' invitingMember,
             localDisplayName,
@@ -981,6 +986,7 @@ createNewMember_
     { memInfo = MemberInfo memberId memberRole memChatVRange memberProfile,
       memCategory = memberCategory,
       memStatus = memberStatus,
+      memRestriction,
       memInvitedBy = invitedBy,
       memInvitedByGroupMemberId,
       localDisplayName,
@@ -995,12 +1001,12 @@ createNewMember_
       db
       [sql|
         INSERT INTO group_members
-          (group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+          (group_id, member_id, member_role, member_category, member_status, member_restriction, invited_by, invited_by_group_member_id,
            user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
            peer_chat_min_version, peer_chat_max_version)
-          VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+          VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
       |]
-      ( (groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, memInvitedByGroupMemberId)
+      ( (groupId, memberId, memberRole, memberCategory, memberStatus, memRestriction, invitedById, memInvitedByGroupMemberId)
           :. (userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt)
           :. (minV, maxV)
       )
@@ -1014,6 +1020,7 @@ createNewMember_
           memberCategory,
           memberStatus,
           memberSettings = defaultMemberSettings,
+          blockedByAdmin = maybe False mrsBlocked memRestriction,
           invitedBy,
           invitedByGroupMemberId = memInvitedByGroupMemberId,
           localDisplayName,
@@ -1189,26 +1196,37 @@ getForwardInvitedMembers db user forwardMember highlyAvailable = do
         WHERE re_group_member_id = ? AND intro_status NOT IN (?,?,?)
       |]
 
-createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember
-createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memChatVRange memberProfile) (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
-  let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
-      cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
-  currentTs <- liftIO getCurrentTime
-  newMember <- case directConnIds of
-    Just (directCmdId, directAgentConnId) -> do
-      Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode
-      liftIO $ setCommandConnId db user directCmdId directConnId
-      (localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs False
-      liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId)
-      pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Just contactId, memProfileId}
-    Nothing -> do
-      (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs
-      pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
-  liftIO $ do
-    member <- createNewMember_ db user gInfo newMember currentTs
-    conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId mcvr memberContactId cLevel currentTs subMode
-    liftIO $ setCommandConnId db user groupCmdId groupConnId
-    pure (member :: GroupMember) {activeConn = Just conn}
+createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember
+createIntroReMember
+  db
+  user@User {userId}
+  gInfo@GroupInfo {groupId}
+  _host@GroupMember {memberContactId, activeConn}
+  memInfo@(MemberInfo _ _ memChatVRange memberProfile)
+  memRestrictions_
+  (groupCmdId, groupAgentConnId)
+  directConnIds
+  customUserProfileId
+  subMode = do
+    let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
+        cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
+        memRestriction = restriction <$> memRestrictions_
+    currentTs <- liftIO getCurrentTime
+    newMember <- case directConnIds of
+      Just (directCmdId, directAgentConnId) -> do
+        Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode
+        liftIO $ setCommandConnId db user directCmdId directConnId
+        (localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs False
+        liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId)
+        pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Just contactId, memProfileId}
+      Nothing -> do
+        (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs
+        pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
+    liftIO $ do
+      member <- createNewMember_ db user gInfo newMember currentTs
+      conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId mcvr memberContactId cLevel currentTs subMode
+      liftIO $ setCommandConnId db user groupCmdId groupConnId
+      pure (member :: GroupMember) {activeConn = Just conn}
 
 createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionRange -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO ()
 createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
@@ -1263,11 +1281,11 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
           g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
           -- GroupInfo {membership}
           mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
-          mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
+          mu.member_status, mu.show_messages, mu.member_restriction, mu.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,
           -- 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.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,
           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.auth_err_counter,
@@ -1358,7 +1376,7 @@ getGroupInfo db vr User {userId, userContactId} groupId =
           g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
           -- 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.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
+          mu.member_status, mu.show_messages, mu.member_restriction, mu.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
         FROM groups g
         JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
@@ -1768,6 +1786,18 @@ updateGroupMemberSettings db User {userId} gId gMemberId GroupMemberSettings {sh
     |]
     (showMessages, currentTs, userId, gId, gMemberId)
 
+updateGroupMemberBlocked :: DB.Connection -> User -> GroupId -> GroupMemberId -> MemberRestrictionStatus -> IO ()
+updateGroupMemberBlocked db User {userId} gId gMemberId memberBlocked = do
+  currentTs <- getCurrentTime
+  DB.execute
+    db
+    [sql|
+      UPDATE group_members
+      SET member_restriction = ?, updated_at = ?
+      WHERE user_id = ? AND group_id = ? AND group_member_id = ?
+    |]
+    (memberBlocked, currentTs, userId, gId, gMemberId)
+
 getXGrpMemIntroContDirect :: DB.Connection -> User -> Contact -> IO (Maybe (Int64, XGrpMemIntroCont))
 getXGrpMemIntroContDirect db User {userId} Contact {contactId} = do
   fmap join . maybeFirstRow toCont $

src/Simplex/Chat/Store/Messages.hs

@@ -52,8 +52,10 @@ module Simplex.Chat.Store.Messages
     updateGroupChatItem,
     deleteGroupChatItem,
     updateGroupChatItemModerated,
+    updateGroupCIBlockedByAdmin,
     markGroupChatItemDeleted,
     markGroupChatItemBlocked,
+    markGroupCIBlockedByAdmin,
     deleteLocalChatItem,
     updateDirectChatItemsRead,
     getDirectUnreadTimedItems,
@@ -462,7 +464,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
             SELECT i.chat_item_id,
               -- GroupMember
               m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
-              m.member_status, m.show_messages, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
+              m.member_status, m.show_messages, m.member_restriction, m.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
             FROM group_members m
             JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
@@ -828,7 +830,7 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex
     ciMeta content status =
       let itemDeleted' = case itemDeleted of
             DBCINotDeleted -> Nothing
-            _ -> Just (CIDeleted @'CTLocal deletedTs)
+            _ -> Just (CIDeleted @CTLocal deletedTs)
           itemEdited' = fromMaybe False itemEdited
        in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
     ciTimed :: Maybe CITimed
@@ -1361,7 +1363,7 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
     ciMeta content status =
       let itemDeleted' = case itemDeleted of
             DBCINotDeleted -> Nothing
-            _ -> Just (CIDeleted @'CTDirect deletedTs)
+            _ -> Just (CIDeleted @CTDirect deletedTs)
           itemEdited' = fromMaybe False itemEdited
        in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
     ciTimed :: Maybe CITimed
@@ -1413,7 +1415,8 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
       let itemDeleted' = case itemDeleted of
             DBCINotDeleted -> Nothing
             DBCIBlocked -> Just (CIBlocked deletedTs)
-            _ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
+            DBCIBlockedByAdmin -> Just (CIBlockedByAdmin deletedTs)
+            _ -> Just (maybe (CIDeleted @CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
           itemEdited' = fromMaybe False itemEdited
        in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt
     ciTimed :: Maybe CITimed
@@ -1764,7 +1767,24 @@ updateGroupChatItemModerated db User {userId} GroupInfo {groupId} ci m@GroupMemb
         WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
       |]
       (deletedTs, groupMemberId, toContent, toText, currentTs, userId, groupId, itemId)
-  pure $ ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted = Just (CIModerated (Just currentTs) m), editable = False}, formattedText = Nothing}
+  pure $ ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted = Just (CIModerated (Just deletedTs) m), editable = False}, formattedText = Nothing}
+
+updateGroupCIBlockedByAdmin :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> UTCTime -> IO (ChatItem 'CTGroup d)
+updateGroupCIBlockedByAdmin db User {userId} GroupInfo {groupId} ci deletedTs = do
+  currentTs <- getCurrentTime
+  let itemId = chatItemId' ci
+  deleteChatItemMessages_ db itemId
+  deleteChatItemVersions_ db itemId
+  liftIO $
+    DB.execute
+      db
+      [sql|
+        UPDATE chat_items
+        SET item_deleted = ?, item_deleted_ts = ?, updated_at = ?
+        WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
+      |]
+      (DBCIBlockedByAdmin, deletedTs, currentTs, userId, groupId, itemId)
+  pure $ ci {meta = (meta ci) {itemDeleted = Just (CIBlockedByAdmin $ Just deletedTs), editable = False}, formattedText = Nothing}
 
 pattern DBCINotDeleted :: Int
 pattern DBCINotDeleted = 0
@@ -1775,13 +1795,16 @@ pattern DBCIDeleted = 1
 pattern DBCIBlocked :: Int
 pattern DBCIBlocked = 2
 
+pattern DBCIBlockedByAdmin :: Int
+pattern DBCIBlockedByAdmin = 3
+
 markGroupChatItemDeleted :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> MessageId -> Maybe GroupMember -> UTCTime -> IO (ChatItem 'CTGroup d)
 markGroupChatItemDeleted db User {userId} GroupInfo {groupId} ci@ChatItem {meta} msgId byGroupMember_ deletedTs = do
   currentTs <- liftIO getCurrentTime
   let itemId = chatItemId' ci
       (deletedByGroupMemberId, itemDeleted) = case byGroupMember_ of
         Just m@GroupMember {groupMemberId} -> (Just groupMemberId, Just $ CIModerated (Just deletedTs) m)
-        _ -> (Nothing, Just $ CIDeleted @'CTGroup (Just deletedTs))
+        _ -> (Nothing, Just $ CIDeleted @CTGroup (Just deletedTs))
   insertChatItemMessage_ db itemId msgId currentTs
   DB.execute
     db
@@ -1806,6 +1829,19 @@ markGroupChatItemBlocked db User {userId} GroupInfo {groupId} ci@ChatItem {meta}
     (DBCIBlocked, deletedTs, deletedTs, userId, groupId, chatItemId' ci)
   pure ci {meta = meta {itemDeleted = Just $ CIBlocked $ Just deletedTs}}
 
+markGroupCIBlockedByAdmin :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup 'MDRcv -> IO (ChatItem 'CTGroup 'MDRcv)
+markGroupCIBlockedByAdmin db User {userId} GroupInfo {groupId} ci@ChatItem {meta} = do
+  deletedTs <- getCurrentTime
+  DB.execute
+    db
+    [sql|
+      UPDATE chat_items
+      SET item_deleted = ?, item_deleted_ts = ?, updated_at = ?
+      WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
+    |]
+    (DBCIBlockedByAdmin, deletedTs, deletedTs, userId, groupId, chatItemId' ci)
+  pure ci {meta = meta {itemDeleted = Just $ CIBlockedByAdmin $ Just deletedTs}}
+
 getGroupChatItemBySharedMsgId :: DB.Connection -> User -> GroupId -> GroupMemberId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTGroup)
 getGroupChatItemBySharedMsgId db user@User {userId} groupId groupMemberId sharedMsgId = do
   itemId <-
@@ -1864,17 +1900,17 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
             i.forwarded_by_group_member_id,
             -- GroupMember
             m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
-            m.member_status, m.show_messages, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
+            m.member_status, m.show_messages, m.member_restriction, m.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,
             -- 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.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
+            rm.member_status, rm.show_messages, rm.member_restriction, rm.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,
             -- 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.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
+            dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.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
           FROM chat_items i
           LEFT JOIN files f ON f.chat_item_id = i.chat_item_id

src/Simplex/Chat/Store/Migrations.hs

@@ -96,6 +96,7 @@ import Simplex.Chat.Migrations.M20231214_item_content_tag
 import Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries
 import Simplex.Chat.Migrations.M20240102_note_folders
 import Simplex.Chat.Migrations.M20240104_members_profile_update
+import Simplex.Chat.Migrations.M20240115_block_member_for_all
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -191,7 +192,8 @@ schemaMigrations =
     ("20231214_item_content_tag", m20231214_item_content_tag, Just down_m20231214_item_content_tag),
     ("20231215_recreate_msg_deliveries", m20231215_recreate_msg_deliveries, Just down_m20231215_recreate_msg_deliveries),
     ("20240102_note_folders", m20240102_note_folders, Just down_m20240102_note_folders),
-    ("20240104_members_profile_update", m20240104_members_profile_update, Just down_m20240104_members_profile_update)
+    ("20240104_members_profile_update", m20240104_members_profile_update, Just down_m20240104_members_profile_update),
+    ("20240115_block_member_for_all", m20240115_block_member_for_all, Just down_m20240115_block_member_for_all)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Chat/Types.hs

@@ -35,6 +35,7 @@ import Data.Int (Int64)
 import Data.Maybe (isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Typeable (Typeable)
 import Database.SQLite.Simple (ResultError (..), SQLData (..))
@@ -50,7 +51,7 @@ import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON)
 import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI)
-import Simplex.Messaging.Util ((<$?>))
+import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
 import Simplex.Messaging.Version
 
 class IsContact a where
@@ -596,9 +597,55 @@ data MemberInfo = MemberInfo
 
 memberInfo :: GroupMember -> MemberInfo
 memberInfo GroupMember {memberId, memberRole, memberProfile, activeConn} =
-  MemberInfo memberId memberRole cvr (redactedMemberProfile $ fromLocalProfile memberProfile)
-  where
-    cvr = ChatVersionRange . fromJVersionRange . peerChatVRange <$> activeConn
+  MemberInfo
+    { memberId,
+      memberRole,
+      v = ChatVersionRange . fromJVersionRange . peerChatVRange <$> activeConn,
+      profile = redactedMemberProfile $ fromLocalProfile memberProfile
+    }
+
+data MemberRestrictionStatus
+  = MRSBlocked
+  | MRSUnrestricted
+  | MRSUnknown Text
+  deriving (Eq, Show)
+
+instance FromField MemberRestrictionStatus where fromField = fromBlobField_ strDecode
+
+instance ToField MemberRestrictionStatus where toField = toField . strEncode
+
+instance StrEncoding MemberRestrictionStatus where
+  strEncode = \case
+    MRSBlocked -> "blocked"
+    MRSUnrestricted -> "unrestricted"
+    MRSUnknown tag -> encodeUtf8 tag
+  strDecode s = Right $ case s of
+    "blocked" -> MRSBlocked
+    "unrestricted" -> MRSUnrestricted
+    tag -> MRSUnknown $ safeDecodeUtf8 tag
+  strP = strDecode <$?> A.takeByteString
+
+instance FromJSON MemberRestrictionStatus where
+  parseJSON = strParseJSON "MemberRestrictionStatus"
+
+instance ToJSON MemberRestrictionStatus where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+mrsBlocked :: MemberRestrictionStatus -> Bool
+mrsBlocked = \case
+  MRSBlocked -> True
+  _ -> False
+
+data MemberRestrictions = MemberRestrictions
+  { restriction :: MemberRestrictionStatus
+  }
+  deriving (Eq, Show)
+
+memberRestrictions :: GroupMember -> Maybe MemberRestrictions
+memberRestrictions m
+  | blockedByAdmin m = Just MemberRestrictions {restriction = MRSBlocked}
+  | otherwise = Nothing
 
 data ReceivedGroupInvitation = ReceivedGroupInvitation
   { fromMember :: GroupMember,
@@ -619,6 +666,7 @@ data GroupMember = GroupMember
     memberCategory :: GroupMemberCategory,
     memberStatus :: GroupMemberStatus,
     memberSettings :: GroupMemberSettings,
+    blockedByAdmin :: Bool,
     invitedBy :: InvitedBy,
     invitedByGroupMemberId :: Maybe GroupMemberId,
     localDisplayName :: ContactName,
@@ -679,6 +727,7 @@ data NewGroupMember = NewGroupMember
   { memInfo :: MemberInfo,
     memCategory :: GroupMemberCategory,
     memStatus :: GroupMemberStatus,
+    memRestriction :: Maybe MemberRestrictionStatus,
     memInvitedBy :: InvitedBy,
     memInvitedByGroupMemberId :: Maybe GroupMemberId,
     localDisplayName :: ContactName,
@@ -1641,6 +1690,8 @@ $(JQ.deriveJSON defaultJSON ''IntroInvitation)
 
 $(JQ.deriveJSON defaultJSON ''MemberInfo)
 
+$(JQ.deriveJSON defaultJSON ''MemberRestrictions)
+
 $(JQ.deriveJSON defaultJSON ''GroupMemberRef)
 
 $(JQ.deriveJSON defaultJSON ''FileDescr)

src/Simplex/Chat/View.hs

@@ -179,6 +179,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRUserDeletedMember u g m -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
   CRLeftMemberUser u g -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
   CRUnknownMemberCreated u g fwdM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember fwdM <> " forwarded a message from an unknown member, creating unknown member record " <> ttyMember um]
+  CRUnknownMemberBlocked u g byM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember byM <> " blocked an unknown member, creating unknown member record " <> ttyMember um]
   CRUnknownMemberAnnounced u g _ um m -> ttyUser u [ttyGroup' g <> ": unknown member " <> ttyMember um <> " updated to " <> ttyMember m]
   CRGroupDeletedUser u g -> ttyUser u [ttyGroup' g <> ": you deleted the group"]
   CRRcvFileDescrReady _ _ -> []
@@ -243,6 +244,8 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRConnectedToGroupMember u g m _ -> ttyUser u [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
   CRMemberRole u g by m r r' -> ttyUser u $ viewMemberRoleChanged g by m r r'
   CRMemberRoleUser u g m r r' -> ttyUser u $ viewMemberRoleUserChanged g m r r'
+  CRMemberBlockedForAll u g by m blocked -> ttyUser u $ viewMemberBlockedForAll g by m blocked
+  CRMemberBlockedForAllUser u g m blocked -> ttyUser u $ viewMemberBlockedForAllUser g m blocked
   CRDeletedMemberUser u g by -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
   CRDeletedMember u g by m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"]
   CRLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
@@ -436,21 +439,16 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
     unmuted' :: User -> ChatInfo c -> CIDirection c d -> Bool -> [StyledString] -> [StyledString]
     unmuted' u chat chatDir mention s
       | chatDirNtf u chat chatDir mention = s
+      | testView = map (<> " <muted>") s
       | otherwise = []
 
 userNtf :: User -> Bool
 userNtf User {showNtfs, activeUser} = showNtfs || activeUser
 
-chatNtf :: User -> ChatInfo c -> Bool -> Bool
-chatNtf user cInfo mention = case cInfo of
-  DirectChat ct -> contactNtf user ct mention
-  GroupChat g -> groupNtf user g mention
-  _ -> False
-
 chatDirNtf :: User -> ChatInfo c -> CIDirection c d -> Bool -> Bool
 chatDirNtf user cInfo chatDir mention = case (cInfo, chatDir) of
   (DirectChat ct, CIDirectRcv) -> contactNtf user ct mention
-  (GroupChat g, CIGroupRcv m) -> groupNtf user g mention && showMessages (memberSettings m)
+  (GroupChat g, CIGroupRcv m) -> groupNtf user g mention && not (blockedByAdmin m) && showMessages (memberSettings m)
   _ -> True
 
 contactNtf :: User -> Contact -> Bool -> Bool
@@ -473,6 +471,7 @@ chatItemDeletedText ChatItem {meta = CIMeta {itemDeleted}, content} membership_
       CIModerated _ m -> markedDeleted content <> byMember m
       CIDeleted _ -> markedDeleted content
       CIBlocked _ -> "blocked"
+      CIBlockedByAdmin _ -> "blocked by admin"
     markedDeleted = \case
       CISndModerated -> "deleted"
       CIRcvModerated -> "deleted"
@@ -555,6 +554,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember},
           CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
           CIRcvGroupInvitation {} -> showRcvItemProhibited from
           CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
+          CIRcvBlocked {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
           _ -> showRcvItem from
           where
             from = ttyFromGroup g m
@@ -978,6 +978,14 @@ viewMemberRoleUserChanged g@GroupInfo {membership} m r r'
   where
     view s = [ttyGroup' g <> ": you changed " <> s <> " from " <> showRole r <> " to " <> showRole r']
 
+viewMemberBlockedForAll :: GroupInfo -> GroupMember -> GroupMember -> Bool -> [StyledString]
+viewMemberBlockedForAll g by m blocked =
+  [ttyGroup' g <> ": " <> ttyMember by <> " " <> (if blocked then "blocked" else "unblocked") <> " " <> ttyMember m]
+
+viewMemberBlockedForAllUser :: GroupInfo -> GroupMember -> Bool -> [StyledString]
+viewMemberBlockedForAllUser g m blocked =
+  [ttyGroup' g <> ": you " <> (if blocked then "blocked" else "unblocked") <> " " <> ttyMember m]
+
 showRole :: GroupMemberRole -> StyledString
 showRole = plain . strEncode
 
@@ -1003,8 +1011,9 @@ viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filt
       GSMemCreator -> ["created group"]
       _ -> []
     muted m
-      | showMessages (memberSettings m) = []
-      | otherwise = ["blocked"]
+      | blockedByAdmin m = ["blocked by admin"]
+      | not (showMessages $ memberSettings m) = ["blocked"]
+      | otherwise = []
 
 viewContactConnected :: Contact -> Maybe Profile -> Bool -> [StyledString]
 viewContactConnected ct userIncognitoProfile testView =
@@ -1847,6 +1856,13 @@ viewChatError logLevel testView = \case
     CEGroupContactRole c -> ["contact " <> ttyContact c <> " has insufficient permissions for this group action"]
     CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> viewGroupName g)]
     CEGroupMemberNotActive -> ["your group connection is not active yet, try later"]
+    CECantBlockMemberForSelf g m showMsgs ->
+      [ "admins or above can't block member for self, use "
+          <> highlight
+            ( (if showMsgs then "/unblock for all" else "/block for all")
+                <> (" #" <> viewGroupName g <> " " <> viewMemberName m)
+            )
+      ]
     CEGroupMemberUserRemoved -> ["you are no longer a member of the group"]
     CEGroupMemberNotFound -> ["group doesn't have this member"]
     CEGroupMemberIntroNotFound c -> ["group member intro not found for " <> ttyContact c]

tests/ChatTests/Direct.hs

@@ -1180,7 +1180,7 @@ testMuteContact =
       bob ##> "/mute @alice"
       bob <## "ok"
       alice #> "@bob hi"
-      (bob </)
+      bob <# "alice> hi <muted>"
       bob ##> "/contacts"
       bob <## "alice (Alice) (muted, you can /unmute @alice)"
       bob ##> "/unmute @alice"
@@ -1204,7 +1204,7 @@ testMuteGroup =
       bob <## "ok"
       alice #> "#team hi"
       concurrently_
-        (bob </)
+        (bob <# "#team alice> hi <muted>")
         (cath <# "#team alice> hi")
       bob #> "#team hello"
       concurrently_
@@ -1214,7 +1214,9 @@ testMuteGroup =
       cath <# "#team > bob hello"
       cath <## "      hello too!"
       concurrentlyN_
-        [ (bob </),
+        [ do
+            bob <# "#team cath> > bob hello <muted>"
+            bob <## "      hello too! <muted>",
           do
             alice <# "#team cath> > bob hello"
             alice <## "      hello too!"
@@ -1236,7 +1238,9 @@ testMuteGroup =
       alice <# "#team > cath hello too!"
       alice <## "      hey cath!"
       concurrentlyN_
-        [ (bob </),
+        [ do
+            bob <# "#team alice> > cath hello too! <muted>"
+            bob <## "      hey cath! <muted>",
           do
             cath <# "#team alice> > cath hello too!"
             cath <## "      hey cath!"
@@ -1245,20 +1249,32 @@ testMuteGroup =
       bob <## "#team (3 members, mentions only, you can /unmute #team)"
       bob ##> "/unmute #team"
       bob <## "ok"
+
+      threadDelay 1000000
+
       alice #> "#team hi again"
       concurrently_
         (bob <# "#team alice> hi again")
         (cath <# "#team alice> hi again")
       bob ##> "/block #team alice"
+      bob <## "admins or above can't block member for self, use /block for all #team alice"
+      -- can bypass with api
+      bob ##> "/_member settings #1 1 {\"showMessages\": false}"
       bob <## "ok"
       bob ##> "/ms team"
       bob <## "bob (Bob): admin, you, connected"
       bob <## "alice (Alice): owner, host, connected, blocked"
       bob <## "cath (Catherine): admin, connected"
+
+      threadDelay 1000000
+
       alice #> "#team test 1"
       concurrently_
-        (bob </)
+        (bob <# "#team alice> test 1 [blocked] <muted>")
         (cath <# "#team alice> test 1")
+
+      threadDelay 1000000
+
       cath #> "#team test 2"
       concurrently_
         (bob <# "#team cath> test 2")
@@ -1269,6 +1285,9 @@ testMuteGroup =
       bob <# "#team cath> test 2"
       threadDelay 1000000
       bob ##> "/unblock #team alice"
+      bob <## "admins or above can't block member for self, use /unblock for all #team alice"
+      -- can bypass with api
+      bob ##> "/_member settings #1 1 {\"showMessages\": true}"
       bob <## "ok"
       bob ##> "/ms team"
       bob <## "bob (Bob): admin, you, connected"

tests/ChatTests/Groups.hs

@@ -141,6 +141,12 @@ chatGroupTests = do
     it "member contact is deleted silently, then considered disabled" testMembershipProfileUpdateContactDisabled
     it "profile update without change is ignored" testMembershipProfileUpdateNoChangeIgnored
     it "change of profile contact link is ignored" testMembershipProfileUpdateContactLinkIgnored
+  describe "block member for all" $ do
+    it "messages are marked blocked" testBlockForAllMarkedBlocked
+    it "messages are fully deleted" testBlockForAllFullDelete
+    it "another admin can unblock" testBlockForAllAnotherAdminUnblocks
+    it "member was blocked before joining group" testBlockForAllBeforeJoining
+    it "can't repeat block, unblock" testBlockForAllCantRepeat
   where
     _0 = supportedChatVRange -- don't create direct connections
     _1 = groupCreateDirectVRange
@@ -5056,7 +5062,8 @@ testGroupHistoryDeletedMessage =
 testGroupHistoryDisappearingMessage :: HasCallStack => FilePath -> IO ()
 testGroupHistoryDisappearingMessage =
   testChat3 aliceProfile bobProfile cathProfile $
-    \alice bob cath -> do
+    -- \alice bob cath -> do -- revert when test is stable
+    \a b c -> withTestOutput a $ \alice -> withTestOutput b $ \bob -> withTestOutput c $ \cath -> do
       createGroup2 "team" alice bob
 
       threadDelay 1000000
@@ -5067,12 +5074,12 @@ testGroupHistoryDisappearingMessage =
       threadDelay 1000000
 
       -- 3 seconds so that messages 2 and 3 are not deleted for alice before sending history to cath
-      alice ##> "/set disappear #team on 3"
+      alice ##> "/set disappear #team on 4"
       alice <## "updated group preferences:"
-      alice <## "Disappearing messages: on (3 sec)"
+      alice <## "Disappearing messages: on (4 sec)"
       bob <## "alice updated group #team:"
       bob <## "updated group preferences:"
-      bob <## "Disappearing messages: on (3 sec)"
+      bob <## "Disappearing messages: on (4 sec)"
 
       bob #> "#team 2"
       alice <# "#team bob> 2"
@@ -5117,15 +5124,18 @@ testGroupHistoryDisappearingMessage =
       r1 `shouldContain` [(0, "1"), (0, "2"), (0, "3"), (0, "4")]
 
       concurrentlyN_
-        [ do
-            alice <## "timed message deleted: 2"
-            alice <## "timed message deleted: 3",
-          do
-            bob <## "timed message deleted: 2"
-            bob <## "timed message deleted: 3",
-          do
-            cath <## "timed message deleted: 2"
-            cath <## "timed message deleted: 3"
+        [ alice
+            <### [ "timed message deleted: 2",
+                   "timed message deleted: 3"
+                 ],
+          bob
+            <### [ "timed message deleted: 2",
+                   "timed message deleted: 3"
+                 ],
+          cath
+            <### [ "timed message deleted: 2",
+                   "timed message deleted: 3"
+                 ]
         ]
 
       cath ##> "/_get chat #1 count=100"
@@ -5695,3 +5705,312 @@ testMembershipProfileUpdateContactLinkIgnored =
       bob <##. "sending messages via"
       bob <## "connection not verified, use /code command to see security code"
       bob <## currentChatVRangeInfo
+
+testBlockForAllMarkedBlocked :: HasCallStack => FilePath -> IO ()
+testBlockForAllMarkedBlocked =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup3 "team" alice bob cath
+
+      threadDelay 1000000
+
+      bob #> "#team 1"
+      [alice, cath] *<# "#team bob> 1"
+
+      threadDelay 1000000
+
+      alice ##> "/block for all #team bob"
+      alice <## "#team: you blocked bob"
+      cath <## "#team: alice blocked bob"
+      bob <// 50000
+
+      alice ##> "/ms team"
+      alice
+        <### [ "alice (Alice): owner, you, created group",
+               "bob (Bob): admin, invited, connected, blocked by admin",
+               "cath (Catherine): admin, invited, connected"
+             ]
+
+      cath ##> "/ms team"
+      cath
+        <### [ "cath (Catherine): admin, you, connected",
+               "alice (Alice): owner, host, connected",
+               "bob (Bob): admin, connected, blocked by admin"
+             ]
+
+      bob ##> "/ms team"
+      bob
+        <### [ "bob (Bob): admin, you, connected",
+               "alice (Alice): owner, host, connected",
+               "cath (Catherine): admin, connected"
+             ]
+
+      threadDelay 1000000
+
+      bob #> "#team 2"
+      alice <# "#team bob> 2 [blocked by admin] <muted>"
+      cath <# "#team bob> 2 [blocked by admin] <muted>"
+
+      threadDelay 1000000
+
+      bob #> "#team 3"
+      alice <# "#team bob> 3 [blocked by admin] <muted>"
+      cath <# "#team bob> 3 [blocked by admin] <muted>"
+
+      threadDelay 1000000
+
+      alice ##> "/unblock for all #team bob"
+      alice <## "#team: you unblocked bob"
+      cath <## "#team: alice unblocked bob"
+      bob <// 50000
+
+      threadDelay 1000000
+
+      bob #> "#team 4"
+      [alice, cath] *<# "#team bob> 4"
+
+      alice
+        #$> ( "/_get chat #1 count=6",
+              chat,
+              [ (0, "1"),
+                (1, "blocked bob (Bob)"),
+                (0, "2 [blocked by admin]"),
+                (0, "3 [blocked by admin]"),
+                (1, "unblocked bob (Bob)"),
+                (0, "4")
+              ]
+            )
+      cath
+        #$> ( "/_get chat #1 count=6",
+              chat,
+              [ (0, "1"),
+                (0, "blocked bob (Bob)"),
+                (0, "2 [blocked by admin]"),
+                (0, "3 [blocked by admin]"),
+                (0, "unblocked bob (Bob)"),
+                (0, "4")
+              ]
+            )
+      bob #$> ("/_get chat #1 count=4", chat, [(1, "1"), (1, "2"), (1, "3"), (1, "4")])
+
+testBlockForAllFullDelete :: HasCallStack => FilePath -> IO ()
+testBlockForAllFullDelete =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup3 "team" alice bob cath
+
+      alice ##> "/set delete #team on"
+      alice <## "updated group preferences:"
+      alice <## "Full deletion: on"
+      concurrentlyN_
+        [ do
+            bob <## "alice updated group #team:"
+            bob <## "updated group preferences:"
+            bob <## "Full deletion: on",
+          do
+            cath <## "alice updated group #team:"
+            cath <## "updated group preferences:"
+            cath <## "Full deletion: on"
+        ]
+
+      threadDelay 1000000
+
+      bob #> "#team 1"
+      [alice, cath] *<# "#team bob> 1"
+
+      threadDelay 1000000
+
+      alice ##> "/block for all #team bob"
+      alice <## "#team: you blocked bob"
+      cath <## "#team: alice blocked bob"
+      bob <// 50000
+
+      threadDelay 1000000
+
+      bob #> "#team 2"
+      alice <# "#team bob> blocked [blocked by admin] <muted>"
+      cath <# "#team bob> blocked [blocked by admin] <muted>"
+
+      threadDelay 1000000
+
+      bob #> "#team 3"
+      alice <# "#team bob> blocked [blocked by admin] <muted>"
+      cath <# "#team bob> blocked [blocked by admin] <muted>"
+
+      threadDelay 1000000
+
+      alice ##> "/unblock for all #team bob"
+      alice <## "#team: you unblocked bob"
+      cath <## "#team: alice unblocked bob"
+      bob <// 50000
+
+      threadDelay 1000000
+
+      bob #> "#team 4"
+      [alice, cath] *<# "#team bob> 4"
+
+      alice
+        #$> ( "/_get chat #1 count=6",
+              chat,
+              [ (0, "1"),
+                (1, "blocked bob (Bob)"),
+                (0, "blocked [blocked by admin]"),
+                (0, "blocked [blocked by admin]"),
+                (1, "unblocked bob (Bob)"),
+                (0, "4")
+              ]
+            )
+      cath
+        #$> ( "/_get chat #1 count=6",
+              chat,
+              [ (0, "1"),
+                (0, "blocked bob (Bob)"),
+                (0, "blocked [blocked by admin]"),
+                (0, "blocked [blocked by admin]"),
+                (0, "unblocked bob (Bob)"),
+                (0, "4")
+              ]
+            )
+      bob #$> ("/_get chat #1 count=4", chat, [(1, "1"), (1, "2"), (1, "3"), (1, "4")])
+
+testBlockForAllAnotherAdminUnblocks :: HasCallStack => FilePath -> IO ()
+testBlockForAllAnotherAdminUnblocks =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup3 "team" alice bob cath
+
+      bob #> "#team 1"
+      [alice, cath] *<# "#team bob> 1"
+
+      alice ##> "/block for all #team bob"
+      alice <## "#team: you blocked bob"
+      cath <## "#team: alice blocked bob"
+      bob <// 50000
+
+      bob #> "#team 2"
+      alice <# "#team bob> 2 [blocked by admin] <muted>"
+      cath <# "#team bob> 2 [blocked by admin] <muted>"
+
+      cath ##> "/unblock for all #team bob"
+      cath <## "#team: you unblocked bob"
+      alice <## "#team: cath unblocked bob"
+      bob <// 50000
+
+      bob #> "#team 3"
+      [alice, cath] *<# "#team bob> 3"
+
+      bob #$> ("/_get chat #1 count=3", chat, [(1, "1"), (1, "2"), (1, "3")])
+
+testBlockForAllBeforeJoining :: HasCallStack => FilePath -> IO ()
+testBlockForAllBeforeJoining =
+  testChat4 aliceProfile bobProfile cathProfile danProfile $
+    \alice bob cath dan -> do
+      createGroup3 "team" alice bob cath
+
+      bob #> "#team 1"
+      [alice, cath] *<# "#team bob> 1"
+
+      alice ##> "/block for all #team bob"
+      alice <## "#team: you blocked bob"
+      cath <## "#team: alice blocked bob"
+      bob <// 50000
+
+      bob #> "#team 2"
+      [alice, cath] *<# "#team bob> 2 [blocked by admin] <muted>"
+
+      connectUsers alice dan
+      addMember "team" alice dan GRAdmin
+      dan ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: dan joined the group",
+          do
+            dan <## "#team: you joined the group"
+            dan
+              <### [ "#team: member bob (Bob) is connected",
+                     "#team: member cath (Catherine) is connected"
+                   ],
+          aliceAddedDan bob,
+          aliceAddedDan cath
+        ]
+
+      threadDelay 1000000
+
+      bob #> "#team 3"
+      [alice, cath, dan] *<# "#team bob> 3 [blocked by admin] <muted>"
+
+      threadDelay 1000000
+
+      bob #> "#team 4"
+      [alice, cath, dan] *<# "#team bob> 4 [blocked by admin] <muted>"
+
+      threadDelay 1000000
+
+      alice ##> "/unblock for all #team bob"
+      alice <## "#team: you unblocked bob"
+      cath <## "#team: alice unblocked bob"
+      dan <## "#team: alice unblocked bob"
+      bob <// 50000
+
+      threadDelay 1000000
+
+      bob #> "#team 5"
+      [alice, cath, dan] *<# "#team bob> 5"
+
+      dan ##> "/_get chat #1 count=100"
+      r <- chat <$> getTermLine dan
+      r `shouldContain` [(0, "3 [blocked by admin]"), (0, "4 [blocked by admin]"), (0, "unblocked bob (Bob)"), (0, "5")]
+      r `shouldNotContain` [(0, "1")]
+      r `shouldNotContain` [(0, "1 [blocked by admin]")]
+      r `shouldNotContain` [(0, "2")]
+      r `shouldNotContain` [(0, "2 [blocked by admin]")]
+  where
+    aliceAddedDan :: HasCallStack => TestCC -> IO ()
+    aliceAddedDan cc = do
+      cc <## "#team: alice added dan (Daniel) to the group (connecting...)"
+      cc <## "#team: new member dan is connected"
+
+testBlockForAllCantRepeat :: HasCallStack => FilePath -> IO ()
+testBlockForAllCantRepeat =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup3 "team" alice bob cath
+
+      alice ##> "/unblock for all #team bob"
+      alice <## "bad chat command: already unblocked"
+
+      cath ##> "/unblock for all #team bob"
+      cath <## "bad chat command: already unblocked"
+
+      bob #> "#team 1"
+      [alice, cath] *<# "#team bob> 1"
+
+      alice ##> "/block for all #team bob"
+      alice <## "#team: you blocked bob"
+      cath <## "#team: alice blocked bob"
+      bob <// 50000
+
+      alice ##> "/block for all #team bob"
+      alice <## "bad chat command: already blocked"
+
+      cath ##> "/block for all #team bob"
+      cath <## "bad chat command: already blocked"
+
+      bob #> "#team 2"
+      alice <# "#team bob> 2 [blocked by admin] <muted>"
+      cath <# "#team bob> 2 [blocked by admin] <muted>"
+
+      cath ##> "/unblock for all #team bob"
+      cath <## "#team: you unblocked bob"
+      alice <## "#team: cath unblocked bob"
+      bob <// 50000
+
+      alice ##> "/unblock for all #team bob"
+      alice <## "bad chat command: already unblocked"
+
+      cath ##> "/unblock for all #team bob"
+      cath <## "bad chat command: already unblocked"
+
+      bob #> "#team 3"
+      [alice, cath] *<# "#team bob> 3"
+
+      bob #$> ("/_get chat #1 count=3", chat, [(1, "1"), (1, "2"), (1, "3")])

tests/ProtocolTests.hs

@@ -243,10 +243,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
       #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
   it "x.grp.mem.intro" $
     "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
-      #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile}
+      #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} Nothing
   it "x.grp.mem.intro with member chat version range" $
     "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-7\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
-      #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
+      #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} Nothing
+  it "x.grp.mem.intro with member restrictions" $
+    "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberRestrictions\":{\"restriction\":\"blocked\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
+      #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} (Just MemberRestrictions {restriction = MRSBlocked})
   it "x.grp.mem.inv" $
     "{\"v\":\"1\",\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}"
       #==# XGrpMemInv (MemberId "\1\2\3\4") IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq}