core: support observers send messages to admins, CLI commands (#5921)

* core: allow observers send messages to admins

* improve parser, CLI command to approve members
This commit is contained in:
Evgeny
2025-05-19 11:14:43 +01:00
committed by GitHub
parent 98f35a38e8
commit a2577c3df3
8 changed files with 112 additions and 45 deletions
+2 -1
View File
@@ -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}
+43 -23
View File
@@ -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 ->
+18 -11
View File
@@ -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
+10
View File
@@ -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 -> "@"
+13 -6
View File
@@ -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]
+1 -1
View File
@@ -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
+23 -1
View File
@@ -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 </)
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
+2 -2
View File
@@ -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