From a2577c3df3a411f539db29daafbcfa7a27fe3983 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Mon, 19 May 2025 11:14:43 +0100 Subject: [PATCH] core: support observers send messages to admins, CLI commands (#5921) * core: allow observers send messages to admins * improve parser, CLI command to approve members --- src/Simplex/Chat/Controller.hs | 3 +- src/Simplex/Chat/Library/Commands.hs | 66 +++++++++++++++++--------- src/Simplex/Chat/Library/Subscriber.hs | 29 ++++++----- src/Simplex/Chat/Messages.hs | 10 ++++ src/Simplex/Chat/Protocol.hs | 19 +++++--- src/Simplex/Chat/View.hs | 2 +- tests/ChatTests/Groups.hs | 24 +++++++++- tests/ProtocolTests.hs | 4 +- 8 files changed, 112 insertions(+), 45 deletions(-) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 7653322c8d..36d6b0aa4a 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -469,7 +469,7 @@ data ChatCommand | ForwardMessage {toChatName :: ChatName, fromContactName :: ContactName, forwardedMsg :: Text} | ForwardGroupMessage {toChatName :: ChatName, fromGroupName :: GroupName, fromMemberName_ :: Maybe ContactName, forwardedMsg :: Text} | ForwardLocalMessage {toChatName :: ChatName, forwardedMsg :: Text} - | SendMessage ChatName Text + | SendMessage SendName Text | SendMemberContactMessage GroupName ContactName Text | SendLiveMessage ChatName Text | SendMessageQuote {contactName :: ContactName, msgDir :: AMsgDirection, quotedMsg :: Text, message :: Text} @@ -483,6 +483,7 @@ data ChatCommand | NewGroup IncognitoEnabled GroupProfile | AddMember GroupName ContactName GroupMemberRole | JoinGroup {groupName :: GroupName, enableNtfs :: MsgFilter} + | AcceptMember GroupName ContactName GroupMemberRole | MemberRole GroupName ContactName GroupMemberRole | BlockForAll GroupName ContactName Bool | RemoveMembers {groupName :: GroupName, members :: Set ContactName, withMessages :: Bool} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 950eef7704..7e0ff3b4c7 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -27,6 +27,7 @@ import Control.Monad.Reader import qualified Data.Aeson as J import Data.Attoparsec.ByteString.Char8 (Parser) import qualified Data.Attoparsec.ByteString.Char8 as A +import qualified Data.Attoparsec.Combinator as A import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B @@ -1848,10 +1849,10 @@ processChatCommand' vr = \case forwardedItemId <- withFastStore $ \db -> getLocalChatItemIdByText' db user folderId forwardedMsg toChatRef <- getChatRef user toChatName processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTLocal folderId Nothing) (forwardedItemId :| []) Nothing - SendMessage (ChatName cType name) msg -> withUser $ \user -> do + SendMessage sendName msg -> withUser $ \user -> do let mc = MCText msg - case cType of - CTDirect -> + case sendName of + SNDirect name -> withFastStore' (\db -> runExceptT $ getContactIdByName db user name) >>= \case Right ctId -> do let sendRef = SRDirect ctId @@ -1866,18 +1867,18 @@ processChatCommand' vr = \case throwChatError $ CEContactNotFound name (Just suspectedMember) _ -> throwChatError $ CEContactNotFound name Nothing - CTGroup -> do - (gId, mentions) <- withFastStore $ \db -> do + SNGroup name scope_ -> do + (gId, cScope_, mentions) <- withFastStore $ \db -> do gId <- getGroupIdByName db user name - (gId,) <$> liftIO (getMessageMentions db user gId msg) - let sendRef = SRGroup gId Nothing + cScope_ <- + forM scope_ $ \(GSNMemberSupport mName_) -> + GCSMemberSupport <$> mapM (getGroupMemberIdByName db user gId) mName_ + (gId,cScope_,) <$> liftIO (getMessageMentions db user gId msg) + let sendRef = SRGroup gId cScope_ processChatCommand $ APISendMessages sendRef False Nothing [ComposedMessage Nothing Nothing mc mentions] - CTLocal - | name == "" -> do - folderId <- withFastStore (`getUserNoteFolderId` user) - processChatCommand $ APICreateChatItems folderId [composedMessage Nothing mc] - | otherwise -> throwCmdError "not supported" - _ -> throwCmdError "not supported" + SNLocal -> do + folderId <- withFastStore (`getUserNoteFolderId` user) + processChatCommand $ APICreateChatItems folderId [composedMessage Nothing mc] SendMemberContactMessage gName mName msg -> withUser $ \user -> do (gId, mId) <- getGroupAndMemberId user gName mName m <- withFastStore $ \db -> getGroupMember db vr user gId mId @@ -2331,6 +2332,7 @@ processChatCommand' vr = \case JoinGroup gName enableNtfs -> withUser $ \user -> do groupId <- withFastStore $ \db -> getGroupIdByName db user gName processChatCommand $ APIJoinGroup groupId enableNtfs + AcceptMember gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIAcceptMember gId gMemberId memRole MemberRole gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIMembersRole gId [gMemberId] memRole BlockForAll gName gMemberName blocked -> withMemberName gName gMemberName $ \gId gMemberId -> APIBlockMembersForAll gId [gMemberId] blocked RemoveMembers gName gMemberNames withMessages -> withUser $ \user -> do @@ -2421,7 +2423,8 @@ processChatCommand' vr = \case when (contactGrpInvSent ct) $ throwCmdError "x.grp.direct.inv already sent" case memberConn m of Just mConn -> do - let msg = XGrpDirectInv cReq msgContent_ + -- TODO [knocking] send in correct scope - modiy API + let msg = XGrpDirectInv cReq msgContent_ Nothing (sndMsg, _, _) <- sendDirectMemberMessage mConn msg groupId withFastStore' $ \db -> setContactGrpInvSent db ct True let ct' = ct {contactGrpInvSent = True} @@ -3372,7 +3375,7 @@ processChatCommand' vr = \case Nothing -> Just GRAuthor Just (GCSMemberSupport Nothing) | memberPending membership -> Nothing - | otherwise -> Just GRAuthor + | otherwise -> Just GRObserver Just (GCSMemberSupport (Just _gmId)) -> Just GRModerator assertGroupContentAllowed :: CM () assertGroupContentAllowed = @@ -4190,6 +4193,7 @@ chatCommandP = "/_group " *> (APINewGroup <$> A.decimal <*> incognitoOnOffP <* A.space <*> jsonP), ("/add " <|> "/a ") *> char_ '#' *> (AddMember <$> displayNameP <* A.space <* char_ '@' <*> displayNameP <*> (memberRole <|> pure GRMember)), ("/join " <|> "/j ") *> char_ '#' *> (JoinGroup <$> displayNameP <*> (" mute" $> MFNone <|> pure MFAll)), + "/accept member " *> char_ '#' *> (AcceptMember <$> displayNameP <* A.space <* char_ '@' <*> displayNameP <*> (memberRole <|> pure GRMember)), ("/member role " <|> "/mr ") *> char_ '#' *> (MemberRole <$> displayNameP <* A.space <* char_ '@' <*> displayNameP <*> memberRole), "/block for all #" *> (BlockForAll <$> displayNameP <* A.space <*> (char_ '@' *> displayNameP) <*> pure True), "/unblock for all #" *> (BlockForAll <$> displayNameP <* A.space <*> (char_ '@' *> displayNameP) <*> pure False), @@ -4236,8 +4240,7 @@ chatCommandP = ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayNameP <* A.space <* A.char '@' <*> (Just <$> displayNameP) <* A.space <*> msgTextP, ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayNameP <*> pure Nothing <* A.space <*> msgTextP, ForwardLocalMessage <$> chatNameP <* " <- * " <*> msgTextP, - SendMessage <$> chatNameP <* A.space <*> msgTextP, - "/* " *> (SendMessage (ChatName CTLocal "") <$> msgTextP), + SendMessage <$> sendNameP <* A.space <*> msgTextP, "@#" *> (SendMemberContactMessage <$> displayNameP <* A.space <* char_ '@' <*> displayNameP <* A.space <*> msgTextP), "/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")), (">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv), @@ -4440,14 +4443,27 @@ chatCommandP = chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayNameP chatRefP = do chatTypeP >>= \case - CTGroup -> ChatRef CTGroup <$> A.decimal <*> (Just <$> gcScopeP <|> pure Nothing) + CTGroup -> ChatRef CTGroup <$> A.decimal <*> optional gcScopeP cType -> (\chatId -> ChatRef cType chatId Nothing) <$> A.decimal sendRefP = (A.char '@' $> SRDirect <*> A.decimal) - <|> (A.char '#' $> SRGroup <*> A.decimal <*> (Just <$> gcScopeP <|> pure Nothing)) - gcScopeP = - ("(_support:" *> (GCSMemberSupport . Just <$> A.decimal) <* ")") - <|> ("(_support)" $> (GCSMemberSupport Nothing)) + <|> (A.char '#' $> SRGroup <*> A.decimal <*> optional gcScopeP) + gcScopeP = "(_support" *> (GCSMemberSupport <$> optional (A.char ':' *> A.decimal)) <* A.char ')' + sendNameP = + (A.char '@' $> SNDirect <*> displayNameP) + <|> (A.char '#' $> SNGroup <*> displayNameP <*> gScopeNameP) + <|> ("/*" $> SNLocal) + gScopeNameP = + (supportPfx *> (Just . GSNMemberSupport <$> optional supportMember) <* A.char ')') + -- this branch fails on "(support" followed by incorrect syntax, + -- to avoid sending message to the whole group as `optional gScopeNameP` would do + <|> (optional supportPfx >>= mapM (\_ -> fail "bad chat scope")) + where + supportPfx = A.takeWhile isSpace *> "(support" + supportMember = safeDecodeUtf8 <$> (A.char ':' *> A.takeWhile isSpace *> (A.take . lengthTillLastParen =<< A.lookAhead displayNameP_)) + lengthTillLastParen s = case B.unsnoc s of + Just (_, ')') -> B.length s - 1 + _ -> B.length s msgCountP = A.space *> A.decimal <|> pure 10 ciTTLDecimal = ("default" $> Nothing) <|> (Just <$> A.decimal) ciTTL = @@ -4513,7 +4529,11 @@ chatCommandP = char_ = optional . A.char displayNameP :: Parser Text -displayNameP = safeDecodeUtf8 <$> (quoted '\'' <|> takeNameTill (\c -> isSpace c || c == ',')) +displayNameP = safeDecodeUtf8 <$> displayNameP_ +{-# INLINE displayNameP #-} + +displayNameP_ :: Parser ByteString +displayNameP_ = quoted '\'' <|> takeNameTill (\c -> isSpace c || c == ',') where takeNameTill p = A.peekChar' >>= \c -> diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 0ecb151120..e554ed4424 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -871,9 +871,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = logInfo $ "group msg=" <> tshow tag <> " " <> eInfo (m'', conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m' conn msgMeta msgBody chatMsg case event of - XMsgNew mc -> memberCanSend m'' $ newGroupContentMessage gInfo' m'' mc msg brokerTs False - XMsgFileDescr sharedMsgId fileDescr -> memberCanSend m'' $ groupMessageFileDescription gInfo' m'' sharedMsgId fileDescr - XMsgUpdate sharedMsgId mContent mentions ttl live msgScope -> memberCanSend m'' $ groupMessageUpdate gInfo' m'' sharedMsgId mContent mentions msgScope msg brokerTs ttl live + XMsgNew mc -> memberCanSend m'' scope $ newGroupContentMessage gInfo' m'' mc msg brokerTs False + where ExtMsgContent {scope} = mcExtMsgContent mc + -- file description is always allowed, to allow sending files to support scope + XMsgFileDescr sharedMsgId fileDescr -> groupMessageFileDescription gInfo' m'' sharedMsgId fileDescr + XMsgUpdate sharedMsgId mContent mentions ttl live msgScope -> memberCanSend m'' msgScope $ groupMessageUpdate gInfo' m'' sharedMsgId mContent mentions msgScope msg brokerTs ttl live XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo' m'' sharedMsgId memberId msg brokerTs XMsgReact sharedMsgId (Just memberId) reaction add -> groupMsgReaction gInfo' m'' sharedMsgId memberId reaction add msg brokerTs -- TODO discontinue XFile @@ -895,7 +897,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = XGrpDel -> xGrpDel gInfo' m'' msg brokerTs XGrpInfo p' -> xGrpInfo gInfo' m'' p' msg brokerTs XGrpPrefs ps' -> xGrpPrefs gInfo' m'' ps' - XGrpDirectInv connReq mContent_ -> memberCanSend m'' $ xGrpDirectInv gInfo' m'' conn' connReq mContent_ msg brokerTs + -- TODO [knocking] why don't we forward these messages? + XGrpDirectInv connReq mContent_ msgScope -> memberCanSend m'' msgScope $ xGrpDirectInv gInfo' m'' conn' connReq mContent_ msg brokerTs XGrpMsgForward memberId msg' msgTs -> xGrpMsgForward gInfo' m'' memberId msg' msgTs XInfoProbe probe -> xInfoProbe (COMGroupMember m'') probe XInfoProbeCheck probeHash -> xInfoProbeCheck (COMGroupMember m'') probeHash @@ -1252,10 +1255,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason _ -> toView $ CEvtReceivedContactRequest user cReq - memberCanSend :: GroupMember -> CM () -> CM () - memberCanSend m@GroupMember {memberRole} a - | memberRole > GRObserver || memberPending m = a - | otherwise = messageError "member is not allowed to send messages" + memberCanSend :: GroupMember -> Maybe MsgScope -> CM () -> CM () + memberCanSend m@GroupMember {memberRole} msgScope a = case msgScope of + Just MSMember {} -> a + Nothing + | memberRole > GRObserver || memberPending m -> a + | otherwise -> messageError "member is not allowed to send messages" processConnMERR :: ConnectionEntity -> Connection -> AgentErrorType -> CM () processConnMERR connEntity conn err = do @@ -2839,9 +2844,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let body = LB.toStrict $ J.encode msg rcvMsg@RcvMessage {chatMsgEvent = ACME _ event} <- saveGroupFwdRcvMsg user groupId m author body chatMsg case event of - XMsgNew mc -> memberCanSend author $ newGroupContentMessage gInfo author mc rcvMsg msgTs True - XMsgFileDescr sharedMsgId fileDescr -> memberCanSend author $ groupMessageFileDescription gInfo author sharedMsgId fileDescr - XMsgUpdate sharedMsgId mContent mentions ttl live msgScope -> memberCanSend author $ groupMessageUpdate gInfo author sharedMsgId mContent mentions msgScope rcvMsg msgTs ttl live + XMsgNew mc -> memberCanSend author scope $ newGroupContentMessage gInfo author mc rcvMsg msgTs True + where ExtMsgContent {scope} = mcExtMsgContent mc + -- file description is always allowed, to allow sending files to support scope + XMsgFileDescr sharedMsgId fileDescr -> groupMessageFileDescription gInfo author sharedMsgId fileDescr + XMsgUpdate sharedMsgId mContent mentions ttl live msgScope -> memberCanSend author msgScope $ groupMessageUpdate gInfo author sharedMsgId mContent mentions msgScope rcvMsg msgTs ttl live XMsgDel sharedMsgId memId -> groupMessageDelete gInfo author sharedMsgId memId rcvMsg msgTs XMsgReact sharedMsgId (Just memId) reaction add -> groupMsgReaction gInfo author sharedMsgId memId reaction add rcvMsg msgTs XFileCancel sharedMsgId -> xFileCancelGroup gInfo author sharedMsgId diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 00dd999139..9a8dc786cd 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -83,6 +83,16 @@ instance TextEncoding GroupChatScopeTag where data ChatName = ChatName {chatType :: ChatType, chatName :: Text} deriving (Show) +data SendName + = SNDirect ContactName + | SNGroup GroupName (Maybe GroupScopeName) + | SNLocal + deriving (Show) + +data GroupScopeName + = GSNMemberSupport (Maybe ContactName) + deriving (Show) + chatTypeStr :: ChatType -> Text chatTypeStr = \case CTDirect -> "@" diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 57383e7b11..151b1b0d27 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -361,7 +361,7 @@ data ChatMsgEvent (e :: MsgEncoding) where XGrpDel :: ChatMsgEvent 'Json XGrpInfo :: GroupProfile -> ChatMsgEvent 'Json XGrpPrefs :: GroupPreferences -> ChatMsgEvent 'Json - XGrpDirectInv :: ConnReqInvitation -> Maybe MsgContent -> ChatMsgEvent 'Json + XGrpDirectInv :: ConnReqInvitation -> Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json XGrpMsgForward :: MemberId -> ChatMessage 'Json -> UTCTime -> ChatMsgEvent 'Json XInfoProbe :: Probe -> ChatMsgEvent 'Json XInfoProbeCheck :: ProbeHash -> ChatMsgEvent 'Json @@ -1011,7 +1011,7 @@ toCMEventTag msg = case msg of XGrpDel -> XGrpDel_ XGrpInfo _ -> XGrpInfo_ XGrpPrefs _ -> XGrpPrefs_ - XGrpDirectInv _ _ -> XGrpDirectInv_ + XGrpDirectInv {} -> XGrpDirectInv_ XGrpMsgForward {} -> XGrpMsgForward_ XInfoProbe _ -> XInfoProbe_ XInfoProbeCheck _ -> XInfoProbeCheck_ @@ -1083,7 +1083,14 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do msg = \case XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params XMsgFileDescr_ -> XMsgFileDescr <$> p "msgId" <*> p "fileDescr" - XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> (fromMaybe M.empty <$> opt "mentions") <*> opt "ttl" <*> opt "live" <*> opt "scope" + XMsgUpdate_ -> do + msgId' <- p "msgId" + content <- p "content" + mentions <- fromMaybe M.empty <$> opt "mentions" + ttl <- opt "ttl" + live <- opt "live" + scope <- opt "scope" + pure XMsgUpdate {msgId = msgId', content, mentions, ttl, live, scope} XMsgDel_ -> XMsgDel <$> p "msgId" <*> opt "memberId" XMsgDeleted_ -> pure XMsgDeleted XMsgReact_ -> XMsgReact <$> p "msgId" <*> opt "memberId" <*> p "reaction" <*> p "add" @@ -1114,7 +1121,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do XGrpDel_ -> pure XGrpDel XGrpInfo_ -> XGrpInfo <$> p "groupProfile" XGrpPrefs_ -> XGrpPrefs <$> p "groupPreferences" - XGrpDirectInv_ -> XGrpDirectInv <$> p "connReq" <*> opt "content" + XGrpDirectInv_ -> XGrpDirectInv <$> p "connReq" <*> opt "content" <*> opt "scope" XGrpMsgForward_ -> XGrpMsgForward <$> p "memberId" <*> p "msg" <*> p "msgTs" XInfoProbe_ -> XInfoProbe <$> p "probe" XInfoProbeCheck_ -> XInfoProbeCheck <$> p "probeHash" @@ -1147,7 +1154,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @ params = \case XMsgNew container -> msgContainerJSON container XMsgFileDescr msgId' fileDescr -> o ["msgId" .= msgId', "fileDescr" .= fileDescr] - XMsgUpdate msgId' content mentions ttl live scope -> o $ ("ttl" .=? ttl) $ ("live" .=? live) $ ("scope" .=? scope) $ ("mentions" .=? nonEmptyMap mentions) ["msgId" .= msgId', "content" .= content] + XMsgUpdate {msgId = msgId', content, mentions, ttl, live, scope} -> o $ ("ttl" .=? ttl) $ ("live" .=? live) $ ("scope" .=? scope) $ ("mentions" .=? nonEmptyMap mentions) ["msgId" .= msgId', "content" .= content] XMsgDel msgId' memberId -> o $ ("memberId" .=? memberId) ["msgId" .= msgId'] XMsgDeleted -> JM.empty XMsgReact msgId' memberId reaction add -> o $ ("memberId" .=? memberId) ["msgId" .= msgId', "reaction" .= reaction, "add" .= add] @@ -1178,7 +1185,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @ XGrpDel -> JM.empty XGrpInfo p -> o ["groupProfile" .= p] XGrpPrefs p -> o ["groupPreferences" .= p] - XGrpDirectInv connReq content -> o $ ("content" .=? content) ["connReq" .= connReq] + XGrpDirectInv connReq content scope -> o $ ("content" .=? content) $ ("scope" .=? scope) ["connReq" .= connReq] XGrpMsgForward memberId msg msgTs -> o ["memberId" .= memberId, "msg" .= msg, "msgTs" .= msgTs] XInfoProbe probe -> o ["probe" .= probe] XInfoProbeCheck probeHash -> o ["probeHash" .= probeHash] diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 2e08afeaef..c11df38dba 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -192,7 +192,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte CRSentConfirmation u _ -> ttyUser u ["confirmation sent!"] CRSentInvitation u _ customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView CRSentInvitationToContact u _c customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView - CRItemsReadForChat u chatId -> ttyUser u ["items read for chat"] + CRItemsReadForChat u _chatId -> ttyUser u ["items read for chat"] CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"] CRChatCleared u chatInfo -> ttyUser u $ viewChatCleared chatInfo CRAcceptingContactRequest u c -> ttyUser u $ viewAcceptingContactRequest c diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index ea83a10cba..591a8fb311 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -195,6 +195,7 @@ chatGroupTests = do describe "group scoped messages" $ do it "should send scoped messages to support (single moderator)" testScopedSupportSingleModerator it "should send scoped messages to support (many moderators)" testScopedSupportManyModerators + it "should send messages to admins and members" testSupportCLISendCommand it "should correctly maintain unread stats for support chats" testScopedSupportUnreadStats testGroupCheckMessages :: HasCallStack => TestParams -> IO () @@ -3009,7 +3010,7 @@ testGLinkApproveMember = alice <# "#team (support: cath) cath> proofs" -- accept member - alice ##> "/_accept member #1 3 member" + alice ##> "/accept member #team cath" concurrentlyN_ [ alice <## "#team: cath accepted", cath @@ -6980,6 +6981,27 @@ testScopedSupportManyModerators = cath ##> "/member support chats #team" cath <## "bob (Bob) (id 3): unread: 0, require attention: 0, mentions: 0" +testSupportCLISendCommand :: HasCallStack => TestParams -> IO () +testSupportCLISendCommand = + testChat2 aliceProfile bobProfile $ \alice bob -> do + createGroup2' "team" alice (bob, GRObserver) True + + alice #> "#team 1" + bob <# "#team alice> 1" + + bob ##> "#team 2" + bob <## "#team: you don't have permission to send messages" + (alice "#team (support: bob) 3" + bob <# "#team (support) alice> 3" + + bob #> "#team (support) 4" + alice <# "#team (support: bob) bob> 4" + + bob ##> "#team (support 4" + bob <## "bad chat command: Failed reading: empty" + testScopedSupportUnreadStats :: HasCallStack => TestParams -> IO () testScopedSupportUnreadStats = testChatOpts4 opts aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index a54a9dd36e..61e75d116b 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -292,10 +292,10 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do ==# XGrpDel it "x.grp.direct.inv" $ "{\"v\":\"1\",\"event\":\"x.grp.direct.inv\",\"params\":{\"connReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-4%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" - #==# XGrpDirectInv testConnReq (Just $ MCText "hello") + #==# XGrpDirectInv testConnReq (Just $ MCText "hello") Nothing it "x.grp.direct.inv without content" $ "{\"v\":\"1\",\"event\":\"x.grp.direct.inv\",\"params\":{\"connReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-4%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}" - #==# XGrpDirectInv testConnReq Nothing + #==# XGrpDirectInv testConnReq Nothing Nothing -- it "x.grp.msg.forward" -- $ "{\"v\":\"1\",\"event\":\"x.grp.msg.forward\",\"params\":{\"msgForward\":{\"memberId\":\"AQIDBA==\",\"msg\":\"{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}\",\"msgTs\":\"1970-01-01T00:00:01.000000001Z\"}}}" -- #==# XGrpMsgForward