mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-15 08:05:49 +00:00
core: auxiliary group chat items (#821)
This commit is contained in:
JRoberts
+54
-26
@@ -31,7 +31,7 @@ import Data.Either (fromRight)
|
||||
import Data.Fixed (div')
|
||||
import Data.Functor (($>))
|
||||
import Data.Int (Int64)
|
||||
import Data.List (find, isSuffixOf, sortBy)
|
||||
import Data.List (find, isSuffixOf, sortBy, sortOn)
|
||||
import Data.List.NonEmpty (NonEmpty, nonEmpty)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Map.Strict (Map)
|
||||
@@ -722,18 +722,23 @@ processChatCommand = \case
|
||||
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId
|
||||
case find ((== memberId) . groupMemberId') members of
|
||||
Nothing -> throwChatError CEGroupMemberNotFound
|
||||
Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus} -> do
|
||||
Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberProfile} -> do
|
||||
let userRole = memberRole (membership :: GroupMember)
|
||||
when (userRole < GRAdmin || userRole < mRole) $ throwChatError CEGroupUserRole
|
||||
withChatLock . procCmd $ do
|
||||
when (mStatus /= GSMemInvited) . void . sendGroupMessage gInfo members $ XGrpMemDel mId
|
||||
when (mStatus /= GSMemInvited) $ do
|
||||
msg <- sendGroupMessage gInfo members $ XGrpMemDel mId
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId memberProfile) Nothing Nothing
|
||||
toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
||||
deleteMemberConnection m
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId m GSMemRemoved
|
||||
pure $ CRUserDeletedMember gInfo m
|
||||
pure $ CRUserDeletedMember gInfo m {memberStatus = GSMemRemoved}
|
||||
APILeaveGroup groupId -> withUser $ \user@User {userId} -> do
|
||||
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId
|
||||
withChatLock . procCmd $ do
|
||||
void $ sendGroupMessage gInfo members XGrpLeave
|
||||
msg <- sendGroupMessage gInfo members XGrpLeave
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft) Nothing Nothing
|
||||
toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
||||
-- TODO delete direct connections that were unused
|
||||
mapM_ deleteMemberConnection members
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemLeft
|
||||
@@ -1151,7 +1156,7 @@ subscribeUserConnections agentBatchSubscribe user = do
|
||||
where
|
||||
mErrors :: [(GroupMember, ChatError)]
|
||||
mErrors =
|
||||
sortBy (comparing (\(GroupMember {localDisplayName = n}, _) -> n))
|
||||
sortOn (\(GroupMember {localDisplayName = n}, _) -> n)
|
||||
. filterErrors
|
||||
$ filter (\(GroupMember {groupId}, _) -> groupId == gId) mRs
|
||||
groupEvent :: ChatResponse
|
||||
@@ -1381,10 +1386,12 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||
sendPendingGroupMessages m conn
|
||||
case memberCategory m of
|
||||
GCHostMember -> do
|
||||
toView $ CRUserJoinedGroup gInfo {membership = membership {memberStatus = GSMemConnected}}
|
||||
memberConnectedChatItem gInfo m
|
||||
toView $ CRUserJoinedGroup gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected}
|
||||
setActive $ ActiveG gName
|
||||
showToast ("#" <> gName) "you are connected to group"
|
||||
GCInviteeMember -> do
|
||||
memberConnectedChatItem gInfo m
|
||||
toView $ CRJoinedGroupMember gInfo m {memberStatus = GSMemConnected}
|
||||
setActive $ ActiveG gName
|
||||
showToast ("#" <> gName) $ "member " <> localDisplayName (m :: GroupMember) <> " is connected"
|
||||
@@ -1415,13 +1422,13 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||
XFile fInv -> processGroupFileInvitation' gInfo m fInv msg msgMeta
|
||||
XFileCancel sharedMsgId -> xFileCancelGroup gInfo m sharedMsgId msgMeta
|
||||
XFileAcptInv sharedMsgId fileConnReq fName -> xFileAcptInvGroup gInfo m sharedMsgId fileConnReq fName msgMeta
|
||||
XGrpMemNew memInfo -> xGrpMemNew gInfo m memInfo
|
||||
XGrpMemNew memInfo -> xGrpMemNew gInfo m memInfo msg msgMeta
|
||||
XGrpMemIntro memInfo -> xGrpMemIntro conn gInfo m memInfo
|
||||
XGrpMemInv memId introInv -> xGrpMemInv gInfo m memId introInv
|
||||
XGrpMemFwd memInfo introInv -> xGrpMemFwd gInfo m memInfo introInv
|
||||
XGrpMemDel memId -> xGrpMemDel gInfo m memId
|
||||
XGrpLeave -> xGrpLeave gInfo m
|
||||
XGrpDel -> xGrpDel gInfo m
|
||||
XGrpMemDel memId -> xGrpMemDel gInfo m memId msg msgMeta
|
||||
XGrpLeave -> xGrpLeave gInfo m msg msgMeta
|
||||
XGrpDel -> xGrpDel gInfo m msg msgMeta
|
||||
_ -> messageError $ "unsupported message: " <> T.pack (show chatMsgEvent)
|
||||
ackMsgDeliveryEvent conn msgMeta
|
||||
SENT msgId ->
|
||||
@@ -1571,8 +1578,19 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||
cancelRcvFileTransfer user ft
|
||||
throwChatError $ CEFileRcvChunk err
|
||||
|
||||
memberConnectedChatItem :: GroupInfo -> GroupMember -> m ()
|
||||
memberConnectedChatItem gInfo m = do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
let content = CIRcvGroupEvent RGEMemberConnected
|
||||
cd = CDGroupRcv gInfo m
|
||||
-- first ts should be broker ts but we don't have it for CON
|
||||
ciId <- withStore' $ \db -> createNewChatItemNoMsg db user cd content createdAt createdAt
|
||||
ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing createdAt createdAt
|
||||
toView $ CRNewChatItem $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci
|
||||
|
||||
notifyMemberConnected :: GroupInfo -> GroupMember -> m ()
|
||||
notifyMemberConnected gInfo m@GroupMember {localDisplayName = c} = do
|
||||
memberConnectedChatItem gInfo m
|
||||
toView $ CRConnectedToGroupMember gInfo m
|
||||
let g = groupName' gInfo
|
||||
setActive $ ActiveG g
|
||||
@@ -1925,14 +1943,16 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||
-- TODO show/log error, other events in SMP confirmation
|
||||
_ -> pure ()
|
||||
|
||||
xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> m ()
|
||||
xGrpMemNew gInfo m memInfo@(MemberInfo memId _ _) = do
|
||||
xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> RcvMessage -> MsgMeta -> m ()
|
||||
xGrpMemNew gInfo m memInfo@(MemberInfo memId _ memberProfile) msg msgMeta = do
|
||||
members <- withStore' $ \db -> getGroupMembers db user gInfo
|
||||
unless (sameMemberId memId $ membership gInfo) $
|
||||
if isMember memId gInfo members
|
||||
then messageError "x.grp.mem.new error: member already exists"
|
||||
else do
|
||||
newMember <- withStore $ \db -> createNewGroupMember db user gInfo memInfo GCPostMember GSMemAnnounced
|
||||
newMember@GroupMember {groupMemberId} <- withStore $ \db -> createNewGroupMember db user gInfo memInfo GCPostMember GSMemAnnounced
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile) Nothing
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
toView $ CRJoinedGroupMemberConnecting gInfo m newMember
|
||||
|
||||
xGrpMemIntro :: Connection -> GroupInfo -> GroupMember -> MemberInfo -> m ()
|
||||
@@ -1979,43 +1999,51 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||
directConnId <- withAgent $ \a -> joinConnection a directConnReq $ directMessage msg
|
||||
withStore' $ \db -> createIntroToMemberContact db userId m toMember groupConnId directConnId
|
||||
|
||||
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> m ()
|
||||
xGrpMemDel gInfo@GroupInfo {membership} m memId = do
|
||||
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> MsgMeta -> m ()
|
||||
xGrpMemDel gInfo@GroupInfo {membership} m memId msg msgMeta = do
|
||||
members <- withStore' $ \db -> getGroupMembers db user gInfo
|
||||
if memberId (membership :: GroupMember) == memId
|
||||
then do
|
||||
mapM_ deleteMemberConnection members
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemRemoved
|
||||
toView $ CRDeletedMemberUser gInfo m
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEUserDeleted) Nothing
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
toView $ CRDeletedMemberUser gInfo {membership = membership {memberStatus = GSMemRemoved}} m
|
||||
else case find (sameMemberId memId) members of
|
||||
Nothing -> messageError "x.grp.mem.del with unknown member ID"
|
||||
Just member -> do
|
||||
Just member@GroupMember {groupMemberId, memberProfile} -> do
|
||||
let mRole = memberRole (m :: GroupMember)
|
||||
if mRole < GRAdmin || mRole < memberRole (member :: GroupMember)
|
||||
then messageError "x.grp.mem.del with insufficient member permissions"
|
||||
else do
|
||||
deleteMemberConnection member
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId member GSMemRemoved
|
||||
toView $ CRDeletedMember gInfo m member
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberDeleted groupMemberId memberProfile) Nothing
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
toView $ CRDeletedMember gInfo m member {memberStatus = GSMemRemoved}
|
||||
|
||||
sameMemberId :: MemberId -> GroupMember -> Bool
|
||||
sameMemberId memId GroupMember {memberId} = memId == memberId
|
||||
|
||||
xGrpLeave :: GroupInfo -> GroupMember -> m ()
|
||||
xGrpLeave gInfo m = do
|
||||
xGrpLeave :: GroupInfo -> GroupMember -> RcvMessage -> MsgMeta -> m ()
|
||||
xGrpLeave gInfo m msg msgMeta = do
|
||||
deleteMemberConnection m
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId m GSMemLeft
|
||||
toView $ CRLeftMember gInfo m
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEMemberLeft) Nothing
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
toView $ CRLeftMember gInfo m {memberStatus = GSMemLeft}
|
||||
|
||||
xGrpDel :: GroupInfo -> GroupMember -> m ()
|
||||
xGrpDel gInfo m@GroupMember {memberRole} = do
|
||||
xGrpDel :: GroupInfo -> GroupMember -> RcvMessage -> MsgMeta -> m ()
|
||||
xGrpDel gInfo@GroupInfo {membership} m@GroupMember {memberRole} msg msgMeta = do
|
||||
when (memberRole /= GROwner) $ throwChatError CEGroupUserRole
|
||||
ms <- withStore' $ \db -> do
|
||||
members <- getGroupMembers db user gInfo
|
||||
updateGroupMemberStatus db userId (membership gInfo) GSMemGroupDeleted
|
||||
updateGroupMemberStatus db userId membership GSMemGroupDeleted
|
||||
pure members
|
||||
mapM_ deleteMemberConnection ms
|
||||
toView $ CRGroupDeleted gInfo m
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEMemberLeft) Nothing
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
toView $ CRGroupDeleted gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m
|
||||
|
||||
parseChatMessage :: ByteString -> Either ChatError ChatMessage
|
||||
parseChatMessage = first (ChatError . CEInvalidChatMessage) . strDecode
|
||||
|
||||
@@ -260,7 +260,7 @@ data ChatResponse
|
||||
| CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]}
|
||||
| CRGroupInvitation {groupInfo :: GroupInfo}
|
||||
| CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole}
|
||||
| CRUserJoinedGroup {groupInfo :: GroupInfo}
|
||||
| CRUserJoinedGroup {groupInfo :: GroupInfo, hostMember :: GroupMember}
|
||||
| CRJoinedGroupMember {groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRJoinedGroupMemberConnecting {groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
|
||||
| CRConnectedToGroupMember {groupInfo :: GroupInfo, member :: GroupMember}
|
||||
|
||||
@@ -499,6 +499,23 @@ ciGroupInvitationToText :: CIGroupInvitation -> GroupMemberRole -> Text
|
||||
ciGroupInvitationToText CIGroupInvitation {groupProfile = GroupProfile {displayName, fullName}} role =
|
||||
"invitation to join group " <> displayName <> optionalFullName displayName fullName <> " as " <> (decodeLatin1 . strEncode $ role)
|
||||
|
||||
rcvGroupEventToText :: RcvGroupEvent -> Text
|
||||
rcvGroupEventToText = \case
|
||||
RGEMemberAdded _ p -> "added " <> memberProfileToText p
|
||||
RGEMemberConnected -> "connected"
|
||||
RGEMemberLeft -> "left"
|
||||
RGEMemberDeleted _ p -> "removed " <> memberProfileToText p
|
||||
RGEUserDeleted -> "removed you"
|
||||
RGEGroupDeleted -> "deleted group"
|
||||
|
||||
sndGroupEventToText :: SndGroupEvent -> Text
|
||||
sndGroupEventToText = \case
|
||||
SGEMemberDeleted _ p -> "removed " <> memberProfileToText p
|
||||
SGEUserLeft -> "left"
|
||||
|
||||
memberProfileToText :: Profile -> Text
|
||||
memberProfileToText Profile {displayName, fullName} = displayName <> optionalFullName displayName fullName
|
||||
|
||||
-- This type is used both in API and in DB, so we use different JSON encodings for the database and for the API
|
||||
data CIContent (d :: MsgDirection) where
|
||||
CISndMsgContent :: MsgContent -> CIContent 'MDSnd
|
||||
@@ -510,9 +527,39 @@ data CIContent (d :: MsgDirection) where
|
||||
CIRcvIntegrityError :: MsgErrorType -> CIContent 'MDRcv
|
||||
CIRcvGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDRcv
|
||||
CISndGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDSnd
|
||||
CIRcvGroupEvent :: RcvGroupEvent -> CIContent 'MDRcv
|
||||
CISndGroupEvent :: SndGroupEvent -> CIContent 'MDSnd
|
||||
|
||||
deriving instance Show (CIContent d)
|
||||
|
||||
data RcvGroupEvent
|
||||
= RGEMemberAdded GroupMemberId Profile -- CRJoinedGroupMemberConnecting
|
||||
| RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember
|
||||
| RGEMemberLeft -- CRLeftMember
|
||||
| RGEMemberDeleted GroupMemberId Profile -- CRDeletedMember
|
||||
| RGEUserDeleted -- CRDeletedMemberUser
|
||||
| RGEGroupDeleted -- CRGroupDeleted
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance FromJSON RcvGroupEvent where
|
||||
parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RGE"
|
||||
|
||||
instance ToJSON RcvGroupEvent where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RGE"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RGE"
|
||||
|
||||
data SndGroupEvent
|
||||
= SGEMemberDeleted GroupMemberId Profile -- CRUserDeletedMember
|
||||
| SGEUserLeft -- CRLeftMemberUser
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance FromJSON SndGroupEvent where
|
||||
parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SGE"
|
||||
|
||||
instance ToJSON SndGroupEvent where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SGE"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SGE"
|
||||
|
||||
data CIGroupInvitation = CIGroupInvitation
|
||||
{ groupId :: GroupId,
|
||||
groupMemberId :: GroupMemberId,
|
||||
@@ -551,6 +598,8 @@ ciContentToText = \case
|
||||
CIRcvIntegrityError err -> msgIntegrityError err
|
||||
CIRcvGroupInvitation groupInvitation memberRole -> "received " <> ciGroupInvitationToText groupInvitation memberRole
|
||||
CISndGroupInvitation groupInvitation memberRole -> "sent " <> ciGroupInvitationToText groupInvitation memberRole
|
||||
CIRcvGroupEvent event -> rcvGroupEventToText event
|
||||
CISndGroupEvent event -> sndGroupEventToText event
|
||||
|
||||
msgIntegrityError :: MsgErrorType -> Text
|
||||
msgIntegrityError = \case
|
||||
@@ -597,6 +646,8 @@ data JSONCIContent
|
||||
| JCIRcvIntegrityError {msgError :: MsgErrorType}
|
||||
| JCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole}
|
||||
| JCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole}
|
||||
| JCIRcvGroupEvent {rcvGroupEvent :: RcvGroupEvent}
|
||||
| JCISndGroupEvent {sndGroupEvent :: SndGroupEvent}
|
||||
deriving (Generic)
|
||||
|
||||
instance FromJSON JSONCIContent where
|
||||
@@ -617,6 +668,8 @@ jsonCIContent = \case
|
||||
CIRcvIntegrityError err -> JCIRcvIntegrityError err
|
||||
CIRcvGroupInvitation groupInvitation memberRole -> JCIRcvGroupInvitation {groupInvitation, memberRole}
|
||||
CISndGroupInvitation groupInvitation memberRole -> JCISndGroupInvitation {groupInvitation, memberRole}
|
||||
CIRcvGroupEvent rcvGroupEvent -> JCIRcvGroupEvent {rcvGroupEvent}
|
||||
CISndGroupEvent sndGroupEvent -> JCISndGroupEvent {sndGroupEvent}
|
||||
|
||||
aciContentJSON :: JSONCIContent -> ACIContent
|
||||
aciContentJSON = \case
|
||||
@@ -629,6 +682,8 @@ aciContentJSON = \case
|
||||
JCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err
|
||||
JCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole
|
||||
JCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole
|
||||
JCIRcvGroupEvent {rcvGroupEvent} -> ACIContent SMDRcv $ CIRcvGroupEvent rcvGroupEvent
|
||||
JCISndGroupEvent {sndGroupEvent} -> ACIContent SMDSnd $ CISndGroupEvent sndGroupEvent
|
||||
|
||||
-- platform independent
|
||||
data DBJSONCIContent
|
||||
@@ -641,6 +696,8 @@ data DBJSONCIContent
|
||||
| DBJCIRcvIntegrityError {msgError :: MsgErrorType}
|
||||
| DBJCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole}
|
||||
| DBJCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole}
|
||||
| DBJCIRcvGroupEvent {rcvGroupEvent :: RcvGroupEvent}
|
||||
| DBJCISndGroupEvent {sndGroupEvent :: SndGroupEvent}
|
||||
deriving (Generic)
|
||||
|
||||
instance FromJSON DBJSONCIContent where
|
||||
@@ -661,6 +718,8 @@ dbJsonCIContent = \case
|
||||
CIRcvIntegrityError err -> DBJCIRcvIntegrityError err
|
||||
CIRcvGroupInvitation groupInvitation memberRole -> DBJCIRcvGroupInvitation {groupInvitation, memberRole}
|
||||
CISndGroupInvitation groupInvitation memberRole -> DBJCISndGroupInvitation {groupInvitation, memberRole}
|
||||
CIRcvGroupEvent rcvGroupEvent -> DBJCIRcvGroupEvent {rcvGroupEvent}
|
||||
CISndGroupEvent sndGroupEvent -> DBJCISndGroupEvent {sndGroupEvent}
|
||||
|
||||
aciContentDBJSON :: DBJSONCIContent -> ACIContent
|
||||
aciContentDBJSON = \case
|
||||
@@ -673,6 +732,8 @@ aciContentDBJSON = \case
|
||||
DBJCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err
|
||||
DBJCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole
|
||||
DBJCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole
|
||||
DBJCIRcvGroupEvent {rcvGroupEvent} -> ACIContent SMDRcv $ CIRcvGroupEvent rcvGroupEvent
|
||||
DBJCISndGroupEvent {sndGroupEvent} -> ACIContent SMDSnd $ CISndGroupEvent sndGroupEvent
|
||||
|
||||
data CICallStatus
|
||||
= CISCallPending
|
||||
|
||||
+28
-18
@@ -6,7 +6,6 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Simplex.Chat.View where
|
||||
@@ -60,8 +59,8 @@ responseToView testView = \case
|
||||
CRApiChat chat -> if testView then testViewChat chat else [plain . bshow $ J.encode chat]
|
||||
CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft]
|
||||
CRUserSMPServers smpServers -> viewSMPServers smpServers testView
|
||||
CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item
|
||||
CRLastMessages chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item) chatItems
|
||||
CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item False
|
||||
CRLastMessages chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True) chatItems
|
||||
CRChatItemStatusUpdated _ -> []
|
||||
CRChatItemUpdated (AChatItem _ _ chat item) -> viewItemUpdate chat item
|
||||
CRChatItemDeleted (AChatItem _ _ chat deletedItem) (AChatItem _ _ _ toItem) -> viewItemDelete chat deletedItem toItem
|
||||
@@ -134,7 +133,7 @@ responseToView testView = \case
|
||||
CRGroupInvitation GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} ->
|
||||
[groupInvitation' ldn fullName]
|
||||
CRReceivedGroupInvitation g c role -> viewReceivedGroupInvitation g c role
|
||||
CRUserJoinedGroup g -> [ttyGroup' g <> ": you joined the group"]
|
||||
CRUserJoinedGroup g _ -> [ttyGroup' g <> ": you joined the group"]
|
||||
CRJoinedGroupMember g m -> [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "]
|
||||
CRJoinedGroupMemberConnecting g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
|
||||
CRConnectedToGroupMember g m -> [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
|
||||
@@ -200,22 +199,24 @@ responseToView testView = \case
|
||||
contactList :: [ContactRef] -> String
|
||||
contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs
|
||||
|
||||
viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString]
|
||||
viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case chat of
|
||||
viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> [StyledString]
|
||||
viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow = case chat of
|
||||
DirectChat c -> case chatDir of
|
||||
CIDirectSnd -> case content of
|
||||
CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
|
||||
CISndDeleted _ -> []
|
||||
CISndCall {} -> []
|
||||
CISndGroupInvitation {} -> []
|
||||
CISndDeleted _ -> showSndItem to
|
||||
CISndCall {} -> showSndItem to
|
||||
CISndGroupInvitation {} -> showSndItem to
|
||||
CISndGroupEvent {} -> showSndItemProhibited to
|
||||
where
|
||||
to = ttyToContact' c
|
||||
CIDirectRcv -> case content of
|
||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||
CIRcvDeleted _ -> []
|
||||
CIRcvCall {} -> []
|
||||
CIRcvDeleted _ -> showRcvItem from
|
||||
CIRcvCall {} -> showRcvItem from
|
||||
CIRcvIntegrityError err -> viewRcvIntegrityError from err meta
|
||||
CIRcvGroupInvitation {} -> []
|
||||
CIRcvGroupInvitation {} -> showRcvItem from
|
||||
CIRcvGroupEvent {} -> showRcvItemProhibited from
|
||||
where
|
||||
from = ttyFromContact' c
|
||||
where
|
||||
@@ -223,17 +224,19 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha
|
||||
GroupChat g -> case chatDir of
|
||||
CIGroupSnd -> case content of
|
||||
CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
|
||||
CISndDeleted _ -> []
|
||||
CISndCall {} -> []
|
||||
CISndGroupInvitation {} -> [] -- prohibited
|
||||
CISndDeleted _ -> showSndItem to
|
||||
CISndCall {} -> showSndItem to
|
||||
CISndGroupInvitation {} -> showSndItemProhibited to
|
||||
CISndGroupEvent {} -> showSndItem to
|
||||
where
|
||||
to = ttyToGroup g
|
||||
CIGroupRcv m -> case content of
|
||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||
CIRcvDeleted _ -> []
|
||||
CIRcvCall {} -> []
|
||||
CIRcvDeleted _ -> showRcvItem from
|
||||
CIRcvCall {} -> showRcvItem from
|
||||
CIRcvIntegrityError err -> viewRcvIntegrityError from err meta
|
||||
CIRcvGroupInvitation {} -> [] -- prohibited
|
||||
CIRcvGroupInvitation {} -> showRcvItemProhibited from
|
||||
CIRcvGroupEvent {} -> showRcvItem from
|
||||
where
|
||||
from = ttyFromGroup' g m
|
||||
where
|
||||
@@ -249,6 +252,13 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha
|
||||
("", Just _, []) -> []
|
||||
("", Just CIFile {fileName}, _) -> view dir quote (MCText $ T.pack fileName) meta
|
||||
_ -> view dir quote mc meta
|
||||
showSndItem to = showItem $ sentWithTime_ [to <> plainContent content] meta
|
||||
showRcvItem from = showItem $ receivedWithTime_ from [] meta [plainContent content]
|
||||
showSndItemProhibited to = showItem $ sentWithTime_ [to <> plainContent content <> " " <> prohibited] meta
|
||||
showRcvItemProhibited from = showItem $ receivedWithTime_ from [] meta [plainContent content <> " " <> prohibited]
|
||||
showItem ss = if doShow then ss else []
|
||||
plainContent = plain . ciContentToText
|
||||
prohibited = styled (colored Red) ("[prohibited - it's a bug if this chat item was created in this context, please report it to dev team]" :: String)
|
||||
|
||||
viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString]
|
||||
viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of
|
||||
|
||||
+182
-155
@@ -9,7 +9,7 @@ import ChatClient
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Concurrent.Async (concurrently_)
|
||||
import Control.Concurrent.STM
|
||||
import Control.Monad (forM_)
|
||||
import Control.Monad (forM_, when)
|
||||
import Data.Aeson (ToJSON)
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
@@ -46,6 +46,7 @@ chatTests = do
|
||||
it "direct message delete" testDirectMessageDelete
|
||||
describe "chat groups" $ do
|
||||
describe "add contacts, create group and send/receive messages" testGroup
|
||||
it "add contacts, create group and send/receive messages, check messages" testGroupCheckMessages
|
||||
it "create and join group with 4 members" testGroup2
|
||||
it "create and delete group" testGroupDelete
|
||||
it "invitee delete group when in status invited" testGroupDeleteWhenInvited
|
||||
@@ -362,109 +363,120 @@ testDirectMessageDelete =
|
||||
testGroup :: Spec
|
||||
testGroup = versionTestMatrix3 runTestGroup
|
||||
where
|
||||
runTestGroup alice bob cath = do
|
||||
connectUsers alice bob
|
||||
connectUsers alice cath
|
||||
alice ##> "/g team"
|
||||
alice <## "group #team is created"
|
||||
alice <## "use /a team <name> to add members"
|
||||
alice ##> "/a team bob"
|
||||
concurrentlyN_
|
||||
[ alice <## "invitation to join the group #team sent to bob",
|
||||
do
|
||||
bob <## "#team: alice invites you to join the group as admin"
|
||||
bob <## "use /j team to accept"
|
||||
]
|
||||
bob ##> "/j team"
|
||||
concurrently_
|
||||
(alice <## "#team: bob joined the group")
|
||||
(bob <## "#team: you joined the group")
|
||||
alice ##> "/a team cath"
|
||||
concurrentlyN_
|
||||
[ alice <## "invitation to join the group #team sent to cath",
|
||||
do
|
||||
cath <## "#team: alice invites you to join the group as admin"
|
||||
cath <## "use /j team to accept"
|
||||
]
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
do
|
||||
cath <## "#team: you joined the group"
|
||||
cath <## "#team: member bob (Bob) is connected",
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
alice #> "#team hello"
|
||||
concurrently_
|
||||
(bob <# "#team alice> hello")
|
||||
(cath <# "#team alice> hello")
|
||||
threadDelay 1000000 -- server assigns timestamps with one second precision
|
||||
bob #> "#team hi there"
|
||||
concurrently_
|
||||
(alice <# "#team bob> hi there")
|
||||
(cath <# "#team bob> hi there")
|
||||
threadDelay 1000000
|
||||
cath #> "#team hey team"
|
||||
concurrently_
|
||||
(alice <# "#team cath> hey team")
|
||||
(bob <# "#team cath> hey team")
|
||||
bob <##> cath
|
||||
getReadChats alice bob cath
|
||||
-- list groups
|
||||
alice ##> "/gs"
|
||||
alice <## "#team"
|
||||
-- list group members
|
||||
alice ##> "/ms team"
|
||||
alice
|
||||
<### [ "alice (Alice): owner, you, created group",
|
||||
"bob (Bob): admin, invited, connected",
|
||||
"cath (Catherine): admin, invited, connected"
|
||||
]
|
||||
-- list contacts
|
||||
alice ##> "/cs"
|
||||
alice <## "bob (Bob)"
|
||||
alice <## "cath (Catherine)"
|
||||
-- remove member
|
||||
bob ##> "/rm team cath"
|
||||
concurrentlyN_
|
||||
[ bob <## "#team: you removed cath from the group",
|
||||
alice <## "#team: bob removed cath from the group",
|
||||
do
|
||||
cath <## "#team: bob removed you from the group"
|
||||
cath <## "use /d #team to delete the group"
|
||||
]
|
||||
bob #> "#team hi"
|
||||
concurrently_
|
||||
(alice <# "#team bob> hi")
|
||||
(cath </)
|
||||
alice #> "#team hello"
|
||||
concurrently_
|
||||
(bob <# "#team alice> hello")
|
||||
(cath </)
|
||||
cath ##> "#team hello"
|
||||
cath <## "you are no longer a member of the group"
|
||||
bob <##> cath
|
||||
-- test clearing chat
|
||||
alice #$> ("/clear #team", id, "#team: all messages are removed locally ONLY")
|
||||
alice #$> ("/_get chat #1 count=100", chat, [])
|
||||
bob #$> ("/clear #team", id, "#team: all messages are removed locally ONLY")
|
||||
bob #$> ("/_get chat #1 count=100", chat, [])
|
||||
cath #$> ("/clear #team", id, "#team: all messages are removed locally ONLY")
|
||||
cath #$> ("/_get chat #1 count=100", chat, [])
|
||||
getReadChats :: TestCC -> TestCC -> TestCC -> IO ()
|
||||
getReadChats alice bob cath = do
|
||||
runTestGroup alice bob cath = testGroupShared alice bob cath False
|
||||
|
||||
testGroupCheckMessages :: IO ()
|
||||
testGroupCheckMessages =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> testGroupShared alice bob cath True
|
||||
|
||||
testGroupShared :: TestCC -> TestCC -> TestCC -> Bool -> IO ()
|
||||
testGroupShared alice bob cath checkMessages = do
|
||||
connectUsers alice bob
|
||||
connectUsers alice cath
|
||||
alice ##> "/g team"
|
||||
alice <## "group #team is created"
|
||||
alice <## "use /a team <name> to add members"
|
||||
alice ##> "/a team bob"
|
||||
concurrentlyN_
|
||||
[ alice <## "invitation to join the group #team sent to bob",
|
||||
do
|
||||
bob <## "#team: alice invites you to join the group as admin"
|
||||
bob <## "use /j team to accept"
|
||||
]
|
||||
bob ##> "/j team"
|
||||
concurrently_
|
||||
(alice <## "#team: bob joined the group")
|
||||
(bob <## "#team: you joined the group")
|
||||
when checkMessages $ threadDelay 1000000 -- for deterministic order of messages and "connected" events
|
||||
alice ##> "/a team cath"
|
||||
concurrentlyN_
|
||||
[ alice <## "invitation to join the group #team sent to cath",
|
||||
do
|
||||
cath <## "#team: alice invites you to join the group as admin"
|
||||
cath <## "use /j team to accept"
|
||||
]
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
do
|
||||
cath <## "#team: you joined the group"
|
||||
cath <## "#team: member bob (Bob) is connected",
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
when checkMessages $ threadDelay 1000000 -- for deterministic order of messages and "connected" events
|
||||
alice #> "#team hello"
|
||||
concurrently_
|
||||
(bob <# "#team alice> hello")
|
||||
(cath <# "#team alice> hello")
|
||||
threadDelay 1000000 -- server assigns timestamps with one second precision
|
||||
bob #> "#team hi there"
|
||||
concurrently_
|
||||
(alice <# "#team bob> hi there")
|
||||
(cath <# "#team bob> hi there")
|
||||
threadDelay 1000000
|
||||
cath #> "#team hey team"
|
||||
concurrently_
|
||||
(alice <# "#team cath> hey team")
|
||||
(bob <# "#team cath> hey team")
|
||||
bob <##> cath
|
||||
when checkMessages getReadChats
|
||||
-- list groups
|
||||
alice ##> "/gs"
|
||||
alice <## "#team"
|
||||
-- list group members
|
||||
alice ##> "/ms team"
|
||||
alice
|
||||
<### [ "alice (Alice): owner, you, created group",
|
||||
"bob (Bob): admin, invited, connected",
|
||||
"cath (Catherine): admin, invited, connected"
|
||||
]
|
||||
-- list contacts
|
||||
alice ##> "/cs"
|
||||
alice <## "bob (Bob)"
|
||||
alice <## "cath (Catherine)"
|
||||
-- remove member
|
||||
bob ##> "/rm team cath"
|
||||
concurrentlyN_
|
||||
[ bob <## "#team: you removed cath from the group",
|
||||
alice <## "#team: bob removed cath from the group",
|
||||
do
|
||||
cath <## "#team: bob removed you from the group"
|
||||
cath <## "use /d #team to delete the group"
|
||||
]
|
||||
bob #> "#team hi"
|
||||
concurrently_
|
||||
(alice <# "#team bob> hi")
|
||||
(cath </)
|
||||
alice #> "#team hello"
|
||||
concurrently_
|
||||
(bob <# "#team alice> hello")
|
||||
(cath </)
|
||||
cath ##> "#team hello"
|
||||
cath <## "you are no longer a member of the group"
|
||||
bob <##> cath
|
||||
-- test clearing chat
|
||||
alice #$> ("/clear #team", id, "#team: all messages are removed locally ONLY")
|
||||
alice #$> ("/_get chat #1 count=100", chat, [])
|
||||
bob #$> ("/clear #team", id, "#team: all messages are removed locally ONLY")
|
||||
bob #$> ("/_get chat #1 count=100", chat, [])
|
||||
cath #$> ("/clear #team", id, "#team: all messages are removed locally ONLY")
|
||||
cath #$> ("/_get chat #1 count=100", chat, [])
|
||||
where
|
||||
getReadChats :: IO ()
|
||||
getReadChats = do
|
||||
alice @@@ [("#team", "hey team"), ("@cath", "sent invitation to join group team as admin"), ("@bob", "sent invitation to join group team as admin")]
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(1, "hello"), (0, "hi there"), (0, "hey team")])
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there"), (0, "hey team")])
|
||||
-- "before" and "after" define a chat item id across all chats,
|
||||
-- so we take into account sent group invitations in direct chats
|
||||
alice #$> ("/_get chat #1 after=3 count=100", chat, [(0, "hi there"), (0, "hey team")])
|
||||
alice #$> ("/_get chat #1 before=5 count=100", chat, [(1, "hello"), (0, "hi there")])
|
||||
-- so we take into account group event items as well as sent group invitations in direct chats
|
||||
alice #$> ("/_get chat #1 after=5 count=100", chat, [(0, "hi there"), (0, "hey team")])
|
||||
alice #$> ("/_get chat #1 before=7 count=100", chat, [(0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there")])
|
||||
bob @@@ [("@cath", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")]
|
||||
bob #$> ("/_get chat #1 count=100", chat, [(0, "hello"), (1, "hi there"), (0, "hey team")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (0, "added cath (Catherine)"), (0, "connected"), (0, "hello"), (1, "hi there"), (0, "hey team")])
|
||||
cath @@@ [("@bob", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")]
|
||||
cath #$> ("/_get chat #1 count=100", chat, [(0, "hello"), (0, "hi there"), (1, "hey team")])
|
||||
cath #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (0, "connected"), (0, "hello"), (0, "hi there"), (1, "hey team")])
|
||||
alice #$> ("/_read chat #1 from=1 to=100", id, "ok")
|
||||
bob #$> ("/_read chat #1 from=1 to=100", id, "ok")
|
||||
cath #$> ("/_read chat #1 from=1 to=100", id, "ok")
|
||||
@@ -566,9 +578,13 @@ testGroup2 =
|
||||
dan <##> cath
|
||||
dan <##> alice
|
||||
-- show last messages
|
||||
alice ##> "/t #club 4"
|
||||
alice ##> "/t #club 8"
|
||||
alice -- these strings are expected in any order because of sorting by time and rounding of time for sent
|
||||
<##? [ "#club hello",
|
||||
<##? [ "#club bob> connected",
|
||||
"#club cath> connected",
|
||||
"#club bob> added dan (Daniel)",
|
||||
"#club dan> connected",
|
||||
"#club hello",
|
||||
"#club bob> hi there",
|
||||
"#club cath> hey",
|
||||
"#club dan> how is it going?"
|
||||
@@ -578,9 +594,15 @@ testGroup2 =
|
||||
<##? [ "dan> hi",
|
||||
"@dan hey"
|
||||
]
|
||||
alice ##> "/t 8"
|
||||
alice ##> "/t 12"
|
||||
alice
|
||||
<##? [ "#club hello",
|
||||
<##? [ "@bob sent invitation to join group club as admin",
|
||||
"@cath sent invitation to join group club as admin",
|
||||
"#club bob> connected",
|
||||
"#club cath> connected",
|
||||
"#club bob> added dan (Daniel)",
|
||||
"#club dan> connected",
|
||||
"#club hello",
|
||||
"#club bob> hi there",
|
||||
"#club cath> hey",
|
||||
"#club dan> how is it going?",
|
||||
@@ -811,6 +833,7 @@ testGroupMessageQuotedReply =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
threadDelay 1000000
|
||||
alice #> "#team hello! how are you?"
|
||||
concurrently_
|
||||
(bob <# "#team alice> hello! how are you?")
|
||||
@@ -828,9 +851,9 @@ testGroupMessageQuotedReply =
|
||||
cath <# "#team bob> > alice hello! how are you?"
|
||||
cath <## " hello, all good, you?"
|
||||
)
|
||||
bob #$> ("/_get chat #1 count=100", chat', [((0, "hello! how are you?"), Nothing), ((1, "hello, all good, you?"), Just (0, "hello! how are you?"))])
|
||||
alice #$> ("/_get chat #1 count=100", chat', [((1, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (1, "hello! how are you?"))])
|
||||
cath #$> ("/_get chat #1 count=100", chat', [((0, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (0, "hello! how are you?"))])
|
||||
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello! how are you?"), Nothing), ((1, "hello, all good, you?"), Just (0, "hello! how are you?"))])
|
||||
alice #$> ("/_get chat #1 count=2", chat', [((1, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (1, "hello! how are you?"))])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (0, "hello! how are you?"))])
|
||||
bob `send` "> #team bob (hello, all good) will tell more"
|
||||
bob <# "#team > bob hello, all good, you?"
|
||||
bob <## " will tell more"
|
||||
@@ -880,23 +903,24 @@ testGroupMessageUpdate =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
-- alice: msg id 3, bob, cath: msg id 2 (after group invitations)
|
||||
threadDelay 1000000
|
||||
-- alice, bob: msg id 5, cath: msg id 4 (after group invitations & group events)
|
||||
alice #> "#team hello!"
|
||||
concurrently_
|
||||
(bob <# "#team alice> hello!")
|
||||
(cath <# "#team alice> hello!")
|
||||
|
||||
alice #$> ("/_update item #1 3 text hey 👋", id, "message updated")
|
||||
alice #$> ("/_update item #1 5 text hey 👋", id, "message updated")
|
||||
concurrently_
|
||||
(bob <# "#team alice> [edited] hey 👋")
|
||||
(cath <# "#team alice> [edited] hey 👋")
|
||||
|
||||
alice #$> ("/_get chat #1 count=100", chat', [((1, "hey 👋"), Nothing)])
|
||||
bob #$> ("/_get chat #1 count=100", chat', [((0, "hey 👋"), Nothing)])
|
||||
cath #$> ("/_get chat #1 count=100", chat', [((0, "hey 👋"), Nothing)])
|
||||
alice #$> ("/_get chat #1 count=1", chat', [((1, "hey 👋"), Nothing)])
|
||||
bob #$> ("/_get chat #1 count=1", chat', [((0, "hey 👋"), Nothing)])
|
||||
cath #$> ("/_get chat #1 count=1", chat', [((0, "hey 👋"), Nothing)])
|
||||
|
||||
threadDelay 1000000
|
||||
-- alice: msg id 4, bob, cath: msg id 3
|
||||
-- alice, bob: msg id 6, cath: msg id 5
|
||||
bob `send` "> #team @alice (hey) hi alice"
|
||||
bob <# "#team > alice hey 👋"
|
||||
bob <## " hi alice"
|
||||
@@ -910,16 +934,16 @@ testGroupMessageUpdate =
|
||||
cath <## " hi alice"
|
||||
)
|
||||
|
||||
alice #$> ("/_get chat #1 count=100", chat', [((1, "hey 👋"), Nothing), ((0, "hi alice"), Just (1, "hey 👋"))])
|
||||
bob #$> ("/_get chat #1 count=100", chat', [((0, "hey 👋"), Nothing), ((1, "hi alice"), Just (0, "hey 👋"))])
|
||||
cath #$> ("/_get chat #1 count=100", chat', [((0, "hey 👋"), Nothing), ((0, "hi alice"), Just (0, "hey 👋"))])
|
||||
alice #$> ("/_get chat #1 count=2", chat', [((1, "hey 👋"), Nothing), ((0, "hi alice"), Just (1, "hey 👋"))])
|
||||
bob #$> ("/_get chat #1 count=2", chat', [((0, "hey 👋"), Nothing), ((1, "hi alice"), Just (0, "hey 👋"))])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "hey 👋"), Nothing), ((0, "hi alice"), Just (0, "hey 👋"))])
|
||||
|
||||
alice #$> ("/_update item #1 3 text greetings 🤝", id, "message updated")
|
||||
alice #$> ("/_update item #1 5 text greetings 🤝", id, "message updated")
|
||||
concurrently_
|
||||
(bob <# "#team alice> [edited] greetings 🤝")
|
||||
(cath <# "#team alice> [edited] greetings 🤝")
|
||||
|
||||
alice #$> ("/_update item #1 4 text updating bob's message", id, "cannot update this item")
|
||||
alice #$> ("/_update item #1 6 text updating bob's message", id, "cannot update this item")
|
||||
|
||||
threadDelay 1000000
|
||||
cath `send` "> #team @alice (greetings) greetings!"
|
||||
@@ -935,32 +959,33 @@ testGroupMessageUpdate =
|
||||
bob <## " greetings!"
|
||||
)
|
||||
|
||||
alice #$> ("/_get chat #1 count=100", chat', [((1, "greetings 🤝"), Nothing), ((0, "hi alice"), Just (1, "hey 👋")), ((0, "greetings!"), Just (1, "greetings 🤝"))])
|
||||
bob #$> ("/_get chat #1 count=100", chat', [((0, "greetings 🤝"), Nothing), ((1, "hi alice"), Just (0, "hey 👋")), ((0, "greetings!"), Just (0, "greetings 🤝"))])
|
||||
cath #$> ("/_get chat #1 count=100", chat', [((0, "greetings 🤝"), Nothing), ((0, "hi alice"), Just (0, "hey 👋")), ((1, "greetings!"), Just (0, "greetings 🤝"))])
|
||||
alice #$> ("/_get chat #1 count=3", chat', [((1, "greetings 🤝"), Nothing), ((0, "hi alice"), Just (1, "hey 👋")), ((0, "greetings!"), Just (1, "greetings 🤝"))])
|
||||
bob #$> ("/_get chat #1 count=3", chat', [((0, "greetings 🤝"), Nothing), ((1, "hi alice"), Just (0, "hey 👋")), ((0, "greetings!"), Just (0, "greetings 🤝"))])
|
||||
cath #$> ("/_get chat #1 count=3", chat', [((0, "greetings 🤝"), Nothing), ((0, "hi alice"), Just (0, "hey 👋")), ((1, "greetings!"), Just (0, "greetings 🤝"))])
|
||||
|
||||
testGroupMessageDelete :: IO ()
|
||||
testGroupMessageDelete =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
-- alice: msg id 3, bob, cath: msg id 2 (after group invitations)
|
||||
threadDelay 1000000
|
||||
-- alice, bob: msg id 5, cath: msg id 4 (after group invitations & group events)
|
||||
alice #> "#team hello!"
|
||||
concurrently_
|
||||
(bob <# "#team alice> hello!")
|
||||
(cath <# "#team alice> hello!")
|
||||
|
||||
alice #$> ("/_delete item #1 3 internal", id, "message deleted")
|
||||
alice #$> ("/_delete item #1 5 internal", id, "message deleted")
|
||||
|
||||
alice #$> ("/_get chat #1 count=100", chat, [])
|
||||
bob #$> ("/_get chat #1 count=100", chat, [(0, "hello!")])
|
||||
cath #$> ("/_get chat #1 count=100", chat, [(0, "hello!")])
|
||||
alice #$> ("/_get chat #1 count=1", chat, [(0, "connected")])
|
||||
bob #$> ("/_get chat #1 count=1", chat, [(0, "hello!")])
|
||||
cath #$> ("/_get chat #1 count=1", chat, [(0, "hello!")])
|
||||
|
||||
alice #$> ("/_update item #1 3 text updating deleted message", id, "cannot update this item")
|
||||
alice #$> ("/_send #1 json {\"quotedItemId\": 3, \"msgContent\": {\"type\": \"text\", \"text\": \"quoting deleted message\"}}", id, "cannot reply to this message")
|
||||
alice #$> ("/_update item #1 5 text updating deleted message", id, "cannot update this item")
|
||||
alice #$> ("/_send #1 json {\"quotedItemId\": 5, \"msgContent\": {\"type\": \"text\", \"text\": \"quoting deleted message\"}}", id, "cannot reply to this message")
|
||||
|
||||
threadDelay 1000000
|
||||
-- alice: msg id 4, bob, cath: msg id 3
|
||||
-- alice, bob: msg id 6, cath: msg id 5
|
||||
bob `send` "> #team @alice (hello) hi alic"
|
||||
bob <# "#team > alice hello!"
|
||||
bob <## " hi alic"
|
||||
@@ -974,22 +999,22 @@ testGroupMessageDelete =
|
||||
cath <## " hi alic"
|
||||
)
|
||||
|
||||
alice #$> ("/_get chat #1 count=100", chat', [((0, "hi alic"), Just (1, "hello!"))])
|
||||
bob #$> ("/_get chat #1 count=100", chat', [((0, "hello!"), Nothing), ((1, "hi alic"), Just (0, "hello!"))])
|
||||
cath #$> ("/_get chat #1 count=100", chat', [((0, "hello!"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
|
||||
alice #$> ("/_get chat #1 count=1", chat', [((0, "hi alic"), Just (1, "hello!"))])
|
||||
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alic"), Just (0, "hello!"))])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
|
||||
|
||||
alice #$> ("/_delete item #1 3 broadcast", id, "message deleted")
|
||||
alice #$> ("/_delete item #1 5 broadcast", id, "message deleted")
|
||||
concurrently_
|
||||
(bob <# "#team alice> [deleted] hello!")
|
||||
(cath <# "#team alice> [deleted] hello!")
|
||||
|
||||
alice #$> ("/_delete item #1 4 internal", id, "message deleted")
|
||||
alice #$> ("/_delete item #1 6 internal", id, "message deleted")
|
||||
|
||||
alice #$> ("/_get chat #1 count=100", chat', [])
|
||||
bob #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alic"), Just (0, "hello!"))])
|
||||
cath #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
|
||||
alice #$> ("/_get chat #1 count=1", chat', [((0, "connected"), Nothing)])
|
||||
bob #$> ("/_get chat #1 count=2", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alic"), Just (0, "hello!"))])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
|
||||
|
||||
bob #$> ("/_update item #1 3 text hi alice", id, "message updated")
|
||||
bob #$> ("/_update item #1 6 text hi alice", id, "message updated")
|
||||
concurrently_
|
||||
(alice <# "#team bob> [edited] hi alice")
|
||||
( do
|
||||
@@ -997,28 +1022,28 @@ testGroupMessageDelete =
|
||||
cath <## " hi alice"
|
||||
)
|
||||
|
||||
alice #$> ("/_get chat #1 count=100", chat', [((0, "hi alice"), Nothing)])
|
||||
bob #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alice"), Just (0, "hello!"))])
|
||||
cath #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alice"), Just (0, "hello!"))])
|
||||
alice #$> ("/_get chat #1 count=1", chat', [((0, "hi alice"), Nothing)])
|
||||
bob #$> ("/_get chat #1 count=2", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alice"), Just (0, "hello!"))])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alice"), Just (0, "hello!"))])
|
||||
|
||||
threadDelay 1000000
|
||||
-- alice: msg id 5, bob, cath: msg id 4
|
||||
-- alice, bob: msg id 7, cath: msg id 6
|
||||
cath #> "#team how are you?"
|
||||
concurrently_
|
||||
(alice <# "#team cath> how are you?")
|
||||
(bob <# "#team cath> how are you?")
|
||||
|
||||
cath #$> ("/_delete item #1 4 broadcast", id, "message deleted")
|
||||
cath #$> ("/_delete item #1 6 broadcast", id, "message deleted")
|
||||
concurrently_
|
||||
(alice <# "#team cath> [deleted] how are you?")
|
||||
(bob <# "#team cath> [deleted] how are you?")
|
||||
|
||||
alice #$> ("/_delete item #1 4 broadcast", id, "cannot delete this item")
|
||||
alice #$> ("/_delete item #1 4 internal", id, "message deleted")
|
||||
alice #$> ("/_delete item #1 6 broadcast", id, "cannot delete this item")
|
||||
alice #$> ("/_delete item #1 6 internal", id, "message deleted")
|
||||
|
||||
alice #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing)])
|
||||
bob #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alice"), Just (0, "hello!")), ((0, "this item is deleted (broadcast)"), Nothing)])
|
||||
cath #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alice"), Just (0, "hello!"))])
|
||||
alice #$> ("/_get chat #1 count=1", chat', [((0, "this item is deleted (broadcast)"), Nothing)])
|
||||
bob #$> ("/_get chat #1 count=3", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alice"), Just (0, "hello!")), ((0, "this item is deleted (broadcast)"), Nothing)])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alice"), Just (0, "hello!"))])
|
||||
|
||||
testGroupAsync :: IO ()
|
||||
testGroupAsync = withTmpFiles $ do
|
||||
@@ -1613,6 +1638,7 @@ testGroupSendImage = versionTestMatrix3 runTestGroupSendImage
|
||||
where
|
||||
runTestGroupSendImage alice bob cath = do
|
||||
createGroup3 "team" alice bob cath
|
||||
threadDelay 1000000
|
||||
alice ##> "/_send #1 json {\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}"
|
||||
alice <# "/f #team ./tests/fixtures/test.jpg"
|
||||
alice <## "use /fc 1 to cancel sending"
|
||||
@@ -1649,21 +1675,22 @@ testGroupSendImage = versionTestMatrix3 runTestGroupSendImage
|
||||
dest `shouldBe` src
|
||||
dest2 <- B.readFile "./tests/tmp/test_1.jpg"
|
||||
dest2 `shouldBe` src
|
||||
alice #$> ("/_get chat #1 count=100", chatF, [((1, ""), Just "./tests/fixtures/test.jpg")])
|
||||
bob #$> ("/_get chat #1 count=100", chatF, [((0, ""), Just "./tests/tmp/test.jpg")])
|
||||
cath #$> ("/_get chat #1 count=100", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg")])
|
||||
alice #$> ("/_get chat #1 count=1", chatF, [((1, ""), Just "./tests/fixtures/test.jpg")])
|
||||
bob #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test.jpg")])
|
||||
cath #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg")])
|
||||
|
||||
testGroupSendImageWithTextAndQuote :: IO ()
|
||||
testGroupSendImageWithTextAndQuote =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
threadDelay 1000000
|
||||
bob #> "#team hi team"
|
||||
concurrently_
|
||||
(alice <# "#team bob> hi team")
|
||||
(cath <# "#team bob> hi team")
|
||||
threadDelay 1000000
|
||||
alice ##> "/_send #1 json {\"filePath\": \"./tests/fixtures/test.jpg\", \"quotedItemId\": 3, \"msgContent\": {\"text\":\"hey bob\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}"
|
||||
alice ##> "/_send #1 json {\"filePath\": \"./tests/fixtures/test.jpg\", \"quotedItemId\": 5, \"msgContent\": {\"text\":\"hey bob\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}"
|
||||
alice <# "#team > bob hi team"
|
||||
alice <## " hey bob"
|
||||
alice <# "/f #team ./tests/fixtures/test.jpg"
|
||||
@@ -1705,11 +1732,11 @@ testGroupSendImageWithTextAndQuote =
|
||||
dest `shouldBe` src
|
||||
dest2 <- B.readFile "./tests/tmp/test_1.jpg"
|
||||
dest2 `shouldBe` src
|
||||
alice #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi team"), Just "./tests/fixtures/test.jpg")])
|
||||
alice #$> ("/_get chat #1 count=2", chat'', [((0, "hi team"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi team"), Just "./tests/fixtures/test.jpg")])
|
||||
alice @@@ [("#team", "hey bob"), ("@bob", "sent invitation to join group team as admin"), ("@cath", "sent invitation to join group team as admin")]
|
||||
bob #$> ("/_get chat #1 count=100", chat'', [((1, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi team"), Just "./tests/tmp/test.jpg")])
|
||||
bob #$> ("/_get chat #1 count=2", chat'', [((1, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi team"), Just "./tests/tmp/test.jpg")])
|
||||
bob @@@ [("#team", "hey bob"), ("@alice", "received invitation to join group team as admin")]
|
||||
cath #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")])
|
||||
cath #$> ("/_get chat #1 count=2", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")])
|
||||
cath @@@ [("#team", "hey bob"), ("@alice", "received invitation to join group team as admin")]
|
||||
|
||||
testUserContactLink :: Spec
|
||||
|
||||
Reference in New Issue
Block a user