mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-06-04 10:21:50 +00:00
update chat protocol to use JSON encoding for chat messages (#182)
* started chat protocol * text message example * events json * same style comments * jsonc * num for rendering * try to fix comment rendering * revert num * chat protocol: make msg params closer to types * AppMessage type * combine new and old simplexmq dependencies * json parsers * version-compatible types for connection requests * more parsers * remove import * decode/encode from/to AppMessage * make group invitation a property in params * switch chat to the new agent * remove "compatibility" attempt * new JSON encoding for chat messages * simplexmq from github * update MsgContent name Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
44845ad563
commit
be537f3a24
+69
-74
@@ -50,6 +50,7 @@ import Simplex.Messaging.Agent
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), defaultAgentConfig)
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (parseAll)
|
||||
import Simplex.Messaging.Protocol (MsgBody)
|
||||
import qualified Simplex.Messaging.Protocol as SMP
|
||||
@@ -73,9 +74,9 @@ data ChatCommand
|
||||
| MarkdownHelp
|
||||
| Welcome
|
||||
| AddContact
|
||||
| Connect (Maybe AConnectionRequest)
|
||||
| ConnectAdmin
|
||||
| SendAdminWelcome ContactName
|
||||
| Connect (Maybe AConnectionRequestUri)
|
||||
| -- | ConnectAdmin
|
||||
SendAdminWelcome ContactName
|
||||
| DeleteContact ContactName
|
||||
| ListContacts
|
||||
| CreateMyAddress
|
||||
@@ -117,7 +118,7 @@ defaultChatConfig =
|
||||
},
|
||||
dbPoolSize = 1,
|
||||
tbqSize = 16,
|
||||
fileChunkSize = 7050
|
||||
fileChunkSize = 15000
|
||||
}
|
||||
|
||||
logCfg :: LogConfig
|
||||
@@ -153,7 +154,7 @@ runSimplexChat = runReaderT $ do
|
||||
whenM (asks firstTime) . printToView . chatWelcome user $ Onboarding 0 0 0 0 0
|
||||
race_ runTerminalInput runChatController
|
||||
|
||||
runChatController :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
|
||||
runChatController :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
|
||||
runChatController =
|
||||
raceAny_
|
||||
[ inputSubscriber,
|
||||
@@ -167,7 +168,7 @@ withLock lock =
|
||||
(void . atomically $ takeTMVar lock)
|
||||
(atomically $ putTMVar lock ())
|
||||
|
||||
inputSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
|
||||
inputSubscriber :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
|
||||
inputSubscriber = do
|
||||
q <- asks inputQ
|
||||
l <- asks chatLock
|
||||
@@ -207,7 +208,7 @@ processChatCommand user@User {userId, profile} = \case
|
||||
Connect (Just (ACR SCMInvitation cReq)) -> connect cReq (XInfo profile) >> showSentConfirmation
|
||||
Connect (Just (ACR SCMContact cReq)) -> connect cReq (XContact profile Nothing) >> showSentInvitation
|
||||
Connect Nothing -> showInvalidConnReq
|
||||
ConnectAdmin -> connect adminContactReq (XContact profile Nothing) >> showSentInvitation
|
||||
-- ConnectAdmin -> connect adminContactReq (XContact profile Nothing) >> showSentInvitation
|
||||
SendAdminWelcome cName -> forM_ adminWelcomeMessages $ sendMessageCmd cName
|
||||
DeleteContact cName ->
|
||||
withStore (\st -> getContactGroupNames st userId cName) >>= \case
|
||||
@@ -259,7 +260,7 @@ processChatCommand user@User {userId, profile} = \case
|
||||
unless (memberActive membership) $ chatError CEGroupMemberNotActive
|
||||
let sendInvitation memberId cReq = do
|
||||
sendDirectMessage (contactConn contact) $
|
||||
XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile
|
||||
XGrpInv $ GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
|
||||
showSentGroupInvitation gName cName
|
||||
setActive $ ActiveG gName
|
||||
case contactMember contact members of
|
||||
@@ -276,7 +277,7 @@ processChatCommand user@User {userId, profile} = \case
|
||||
| otherwise -> chatError (CEGroupDuplicateMember cName)
|
||||
JoinGroup gName -> do
|
||||
ReceivedGroupInvitation {fromMember, userMember, connRequest} <- withStore $ \st -> getGroupInvitation st user gName
|
||||
agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId userMember
|
||||
agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId (userMember :: GroupMember)
|
||||
withStore $ \st -> do
|
||||
createMemberConnection st userId fromMember agentConnId
|
||||
updateGroupMemberStatus st userId fromMember GSMemAccepted
|
||||
@@ -286,13 +287,13 @@ processChatCommand user@User {userId, profile} = \case
|
||||
Group {membership, members} <- withStore $ \st -> getGroup st user gName
|
||||
case find ((== cName) . (localDisplayName :: GroupMember -> ContactName)) members of
|
||||
Nothing -> chatError $ CEGroupMemberNotFound cName
|
||||
Just member -> do
|
||||
let userRole = memberRole membership
|
||||
when (userRole < GRAdmin || userRole < memberRole member) $ chatError CEGroupUserRole
|
||||
when (memberStatus member /= GSMemInvited) . sendGroupMessage members $ XGrpMemDel (memberId member)
|
||||
deleteMemberConnection member
|
||||
withStore $ \st -> updateGroupMemberStatus st userId member GSMemRemoved
|
||||
showDeletedMember gName Nothing (Just member)
|
||||
Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus} -> do
|
||||
let userRole = memberRole (membership :: GroupMember)
|
||||
when (userRole < GRAdmin || userRole < mRole) $ chatError CEGroupUserRole
|
||||
when (mStatus /= GSMemInvited) . sendGroupMessage members $ XGrpMemDel mId
|
||||
deleteMemberConnection m
|
||||
withStore $ \st -> updateGroupMemberStatus st userId m GSMemRemoved
|
||||
showDeletedMember gName Nothing (Just m)
|
||||
LeaveGroup gName -> do
|
||||
Group {membership, members} <- withStore $ \st -> getGroup st user gName
|
||||
sendGroupMessage members XGrpLeave
|
||||
@@ -303,7 +304,7 @@ processChatCommand user@User {userId, profile} = \case
|
||||
g@Group {membership, members} <- withStore $ \st -> getGroup st user gName
|
||||
let s = memberStatus membership
|
||||
canDelete =
|
||||
memberRole membership == GROwner
|
||||
memberRole (membership :: GroupMember) == GROwner
|
||||
|| (s == GSMemRemoved || s == GSMemLeft || s == GSMemGroupDeleted || s == GSMemInvited)
|
||||
unless canDelete $ chatError CEGroupUserRole
|
||||
when (memberActive membership) $ sendGroupMessage members XGrpDel
|
||||
@@ -318,7 +319,7 @@ processChatCommand user@User {userId, profile} = \case
|
||||
-- TODO save pending message delivery for members without connections
|
||||
Group {members, membership} <- withStore $ \st -> getGroup st user gName
|
||||
unless (memberActive membership) $ chatError CEGroupMemberUserRemoved
|
||||
let msgEvent = XMsgNew $ MsgContent MTText [] [MsgContentBody {contentType = SimplexContentType XCText, contentData = msg}]
|
||||
let msgEvent = XMsgNew . MCText $ safeDecodeUtf8 msg
|
||||
sendGroupMessage members msgEvent
|
||||
setActive $ ActiveG gName
|
||||
SendFile cName f -> do
|
||||
@@ -376,14 +377,14 @@ processChatCommand user@User {userId, profile} = \case
|
||||
QuitChat -> liftIO exitSuccess
|
||||
ShowVersion -> printToView clientVersionInfo
|
||||
where
|
||||
connect :: ConnectionRequest c -> ChatMsgEvent -> m ()
|
||||
connect :: ConnectionRequestUri c -> ChatMsgEvent -> m ()
|
||||
connect cReq msg = do
|
||||
connId <- withAgent $ \a -> joinConnection a cReq $ directMessage msg
|
||||
withStore $ \st -> createDirectConnection st userId connId
|
||||
sendMessageCmd :: ContactName -> ByteString -> m ()
|
||||
sendMessageCmd cName msg = do
|
||||
contact <- withStore $ \st -> getContact st userId cName
|
||||
let msgEvent = XMsgNew $ MsgContent MTText [] [MsgContentBody {contentType = SimplexContentType XCText, contentData = msg}]
|
||||
let msgEvent = XMsgNew . MCText $ safeDecodeUtf8 msg
|
||||
sendDirectMessage (contactConn contact) msgEvent
|
||||
setActive $ ActiveC cName
|
||||
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
|
||||
@@ -426,7 +427,7 @@ processChatCommand user@User {userId, profile} = \case
|
||||
f = filePath `combine` (name <> suffix <> ext)
|
||||
in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
|
||||
|
||||
agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
|
||||
agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
|
||||
agentSubscriber = do
|
||||
q <- asks $ subQ . smpAgent
|
||||
l <- asks chatLock
|
||||
@@ -437,7 +438,7 @@ agentSubscriber = do
|
||||
withLock l . void . runExceptT $
|
||||
processAgentMessage user connId msg `catchError` showChatError
|
||||
|
||||
subscribeUserConnections :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
|
||||
subscribeUserConnections :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
|
||||
subscribeUserConnections = void . runExceptT $ do
|
||||
user <- readTVarIO =<< asks currentUser
|
||||
subscribeContacts user
|
||||
@@ -519,7 +520,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
where
|
||||
isMember :: MemberId -> Group -> Bool
|
||||
isMember memId Group {membership, members} =
|
||||
memberId membership == memId || isJust (find ((== memId) . memberId) members)
|
||||
sameMemberId memId membership || isJust (find (sameMemberId memId) members)
|
||||
|
||||
contactIsReady :: Contact -> Bool
|
||||
contactIsReady Contact {activeConn} = connStatus activeConn == ConnReady
|
||||
@@ -554,7 +555,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
chatMsgEvent <- saveRcvMSG conn meta msgBody
|
||||
withAckMessage agentConnId meta $
|
||||
case chatMsgEvent of
|
||||
XMsgNew (MsgContent MTText [] body) -> newTextMessage c meta $ find (isSimplexContentType XCText) body
|
||||
XMsgNew (MCText text) -> newTextMessage c meta text
|
||||
XFile fInv -> processFileInvitation ct meta fInv
|
||||
XInfo p -> xInfo ct p
|
||||
XGrpInv gInv -> processGroupInvitation ct gInv
|
||||
@@ -617,7 +618,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
GCInviteeMember ->
|
||||
case chatMsgEvent of
|
||||
XGrpAcpt memId
|
||||
| memId == memberId m -> do
|
||||
| sameMemberId memId m -> do
|
||||
withStore $ \st -> updateGroupMemberStatus st userId m GSMemAccepted
|
||||
allowAgentConnection conn confId XOk
|
||||
| otherwise -> messageError "x.grp.acpt: memberId is different from expected"
|
||||
@@ -625,17 +626,17 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
_ ->
|
||||
case chatMsgEvent of
|
||||
XGrpMemInfo memId _memProfile
|
||||
| memId == memberId m -> do
|
||||
| sameMemberId memId m -> do
|
||||
-- TODO update member profile
|
||||
Group {membership} <- withStore $ \st -> getGroup st user gName
|
||||
allowAgentConnection conn confId $ XGrpMemInfo (memberId membership) profile
|
||||
allowAgentConnection conn confId $ XGrpMemInfo (memberId (membership :: GroupMember)) profile
|
||||
| otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
|
||||
_ -> messageError "CONF from member must have x.grp.mem.info"
|
||||
INFO connInfo -> do
|
||||
ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
|
||||
case chatMsgEvent of
|
||||
XGrpMemInfo memId _memProfile
|
||||
| memId == memberId m -> do
|
||||
| sameMemberId memId m -> do
|
||||
-- TODO update member profile
|
||||
pure ()
|
||||
| otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
|
||||
@@ -678,8 +679,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
chatMsgEvent <- saveRcvMSG conn meta msgBody
|
||||
withAckMessage agentConnId meta $
|
||||
case chatMsgEvent of
|
||||
XMsgNew (MsgContent MTText [] body) ->
|
||||
newGroupTextMessage gName m meta $ find (isSimplexContentType XCText) body
|
||||
XMsgNew (MCText text) -> newGroupTextMessage gName m meta text
|
||||
XFile fInv -> processGroupFileInvitation gName m meta fInv
|
||||
XGrpMemNew memInfo -> xGrpMemNew gName m memInfo
|
||||
XGrpMemIntro memInfo -> xGrpMemIntro conn gName m memInfo
|
||||
@@ -808,7 +808,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
(probe, probeId) <- withStore $ \st -> createSentProbe st gVar userId ct
|
||||
sendDirectMessage (contactConn ct) $ XInfoProbe probe
|
||||
cs <- withStore (\st -> getMatchingContacts st userId ct)
|
||||
let probeHash = C.sha256Hash probe
|
||||
let probeHash = ProbeHash $ C.sha256Hash (unProbe probe)
|
||||
forM_ cs $ \c -> sendProbeHash c probeHash probeId `catchError` const (pure ())
|
||||
where
|
||||
sendProbeHash c probeHash probeId = do
|
||||
@@ -821,23 +821,17 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
messageError :: Text -> m ()
|
||||
messageError = showMessageError "error"
|
||||
|
||||
newTextMessage :: ContactName -> MsgMeta -> Maybe MsgContentBody -> m ()
|
||||
newTextMessage c meta = \case
|
||||
Just MsgContentBody {contentData = bs} -> do
|
||||
let text = safeDecodeUtf8 bs
|
||||
showReceivedMessage c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
|
||||
showToast (c <> "> ") text
|
||||
setActive $ ActiveC c
|
||||
_ -> messageError "x.msg.new: no expected message body"
|
||||
newTextMessage :: ContactName -> MsgMeta -> Text -> m ()
|
||||
newTextMessage c meta text = do
|
||||
showReceivedMessage c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
|
||||
showToast (c <> "> ") text
|
||||
setActive $ ActiveC c
|
||||
|
||||
newGroupTextMessage :: GroupName -> GroupMember -> MsgMeta -> Maybe MsgContentBody -> m ()
|
||||
newGroupTextMessage gName GroupMember {localDisplayName = c} meta = \case
|
||||
Just MsgContentBody {contentData = bs} -> do
|
||||
let text = safeDecodeUtf8 bs
|
||||
showReceivedGroupMessage gName c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
|
||||
showToast ("#" <> gName <> " " <> c <> "> ") text
|
||||
setActive $ ActiveG gName
|
||||
_ -> messageError "x.msg.new: no expected message body"
|
||||
newGroupTextMessage :: GroupName -> GroupMember -> MsgMeta -> Text -> m ()
|
||||
newGroupTextMessage gName GroupMember {localDisplayName = c} meta text = do
|
||||
showReceivedGroupMessage gName c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
|
||||
showToast ("#" <> gName <> " " <> c <> "> ") text
|
||||
setActive $ ActiveG gName
|
||||
|
||||
processFileInvitation :: Contact -> MsgMeta -> FileInvitation -> m ()
|
||||
processFileInvitation contact@Contact {localDisplayName = c} meta fInv = do
|
||||
@@ -855,7 +849,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
setActive $ ActiveG gName
|
||||
|
||||
processGroupInvitation :: Contact -> GroupInvitation -> m ()
|
||||
processGroupInvitation ct@Contact {localDisplayName} inv@(GroupInvitation (fromMemId, fromRole) (memId, memRole) _ _) = do
|
||||
processGroupInvitation ct@Contact {localDisplayName} inv@(GroupInvitation (MemberIdRole fromMemId fromRole) (MemberIdRole memId memRole) _ _) = do
|
||||
when (fromRole < GRAdmin || fromRole < memRole) $ chatError (CEGroupContactRole localDisplayName)
|
||||
when (fromMemId == memId) $ chatError CEGroupDuplicateMemberId
|
||||
group <- withStore $ \st -> createGroupInvitation st user ct inv
|
||||
@@ -866,23 +860,23 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
c' <- withStore $ \st -> updateContactProfile st userId c p'
|
||||
showContactUpdated c c'
|
||||
|
||||
xInfoProbe :: Contact -> ByteString -> m ()
|
||||
xInfoProbe :: Contact -> Probe -> m ()
|
||||
xInfoProbe c2 probe = do
|
||||
r <- withStore $ \st -> matchReceivedProbe st userId c2 probe
|
||||
forM_ r $ \c1 -> probeMatch c1 c2 probe
|
||||
|
||||
xInfoProbeCheck :: Contact -> ByteString -> m ()
|
||||
xInfoProbeCheck :: Contact -> ProbeHash -> m ()
|
||||
xInfoProbeCheck c1 probeHash = do
|
||||
r <- withStore $ \st -> matchReceivedProbeHash st userId c1 probeHash
|
||||
forM_ r . uncurry $ probeMatch c1
|
||||
|
||||
probeMatch :: Contact -> Contact -> ByteString -> m ()
|
||||
probeMatch :: Contact -> Contact -> Probe -> m ()
|
||||
probeMatch c1@Contact {profile = p1} c2@Contact {profile = p2} probe =
|
||||
when (p1 == p2) $ do
|
||||
sendDirectMessage (contactConn c1) $ XInfoProbeOk probe
|
||||
mergeContacts c1 c2
|
||||
|
||||
xInfoProbeOk :: Contact -> ByteString -> m ()
|
||||
xInfoProbeOk :: Contact -> Probe -> m ()
|
||||
xInfoProbeOk c1 probe = do
|
||||
r <- withStore $ \st -> matchSentProbe st userId c1 probe
|
||||
forM_ r $ \c2 -> mergeContacts c1 c2
|
||||
@@ -904,7 +898,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
xGrpMemNew :: GroupName -> GroupMember -> MemberInfo -> m ()
|
||||
xGrpMemNew gName m memInfo@(MemberInfo memId _ _) = do
|
||||
group@Group {membership} <- withStore $ \st -> getGroup st user gName
|
||||
when (memberId membership /= memId) $
|
||||
unless (sameMemberId memId membership) $
|
||||
if isMember memId group
|
||||
then messageError "x.grp.mem.new error: member already exists"
|
||||
else do
|
||||
@@ -932,7 +926,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
case memberCategory m of
|
||||
GCInviteeMember -> do
|
||||
group <- withStore $ \st -> getGroup st user gName
|
||||
case find ((== memId) . memberId) $ members group of
|
||||
case find (sameMemberId memId) $ members group of
|
||||
Nothing -> messageError "x.grp.mem.inv error: referenced member does not exists"
|
||||
Just reMember -> do
|
||||
intro <- withStore $ \st -> saveIntroInvitation st reMember m introInv
|
||||
@@ -946,7 +940,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
xGrpMemFwd :: GroupName -> GroupMember -> MemberInfo -> IntroInvitation -> m ()
|
||||
xGrpMemFwd gName m memInfo@(MemberInfo memId _ _) introInv@IntroInvitation {groupConnReq, directConnReq} = do
|
||||
group@Group {membership} <- withStore $ \st -> getGroup st user gName
|
||||
toMember <- case find ((== memId) . memberId) $ members group of
|
||||
toMember <- case find (sameMemberId memId) $ members group of
|
||||
-- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent
|
||||
-- the situation when member does not exist is an error
|
||||
-- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that.
|
||||
@@ -954,7 +948,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
Nothing -> withStore $ \st -> createNewGroupMember st user group memInfo GCPostMember GSMemAnnounced
|
||||
Just m' -> pure m'
|
||||
withStore $ \st -> saveMemberInvitation st toMember introInv
|
||||
let msg = XGrpMemInfo (memberId membership) profile
|
||||
let msg = XGrpMemInfo (memberId (membership :: GroupMember)) profile
|
||||
groupConnId <- withAgent $ \a -> joinConnection a groupConnReq $ directMessage msg
|
||||
directConnId <- withAgent $ \a -> joinConnection a directConnReq $ directMessage msg
|
||||
withStore $ \st -> createIntroToMemberContact st userId m toMember groupConnId directConnId
|
||||
@@ -962,22 +956,25 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
xGrpMemDel :: GroupName -> GroupMember -> MemberId -> m ()
|
||||
xGrpMemDel gName m memId = do
|
||||
Group {membership, members} <- withStore $ \st -> getGroup st user gName
|
||||
if memberId membership == memId
|
||||
if memberId (membership :: GroupMember) == memId
|
||||
then do
|
||||
mapM_ deleteMemberConnection members
|
||||
withStore $ \st -> updateGroupMemberStatus st userId membership GSMemRemoved
|
||||
showDeletedMemberUser gName m
|
||||
else case find ((== memId) . memberId) members of
|
||||
else case find (sameMemberId memId) members of
|
||||
Nothing -> messageError "x.grp.mem.del with unknown member ID"
|
||||
Just member -> do
|
||||
let mRole = memberRole m
|
||||
if mRole < GRAdmin || mRole < memberRole member
|
||||
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 $ \st -> updateGroupMemberStatus st userId member GSMemRemoved
|
||||
showDeletedMember gName (Just m) (Just member)
|
||||
|
||||
sameMemberId :: MemberId -> GroupMember -> Bool
|
||||
sameMemberId memId GroupMember {memberId} = memId == memberId
|
||||
|
||||
xGrpLeave :: GroupName -> GroupMember -> m ()
|
||||
xGrpLeave gName m = do
|
||||
deleteMemberConnection m
|
||||
@@ -985,8 +982,8 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
showLeftMember gName m
|
||||
|
||||
xGrpDel :: GroupName -> GroupMember -> m ()
|
||||
xGrpDel gName m = do
|
||||
when (memberRole m /= GROwner) $ chatError CEGroupUserRole
|
||||
xGrpDel gName m@GroupMember {memberRole} = do
|
||||
when (memberRole /= GROwner) $ chatError CEGroupUserRole
|
||||
ms <- withStore $ \st -> do
|
||||
Group {members, membership} <- getGroup st user gName
|
||||
updateGroupMemberStatus st userId membership GSMemGroupDeleted
|
||||
@@ -995,7 +992,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
showGroupDeleted gName m
|
||||
|
||||
parseChatMessage :: ByteString -> Either ChatError ChatMessage
|
||||
parseChatMessage msgBody = first ChatErrorMessage (parseAll rawChatMessageP msgBody >>= toChatMessage)
|
||||
parseChatMessage = first ChatErrorMessage . strDecode
|
||||
|
||||
sendFileChunk :: ChatMonad m => SndFileTransfer -> m ()
|
||||
sendFileChunk ft@SndFileTransfer {fileId, fileStatus, agentConnId} =
|
||||
@@ -1105,15 +1102,13 @@ deleteMemberConnection m@GroupMember {activeConn} = do
|
||||
sendDirectMessage :: ChatMonad m => Connection -> ChatMsgEvent -> m ()
|
||||
sendDirectMessage conn chatMsgEvent = do
|
||||
let msgBody = directMessage chatMsgEvent
|
||||
newMsg = NewMessage {direction = MDSnd, chatMsgEventType = toChatEventType chatMsgEvent, msgBody}
|
||||
newMsg = NewMessage {direction = MDSnd, chatMsgEventType = toChatEventTag chatMsgEvent, msgBody}
|
||||
-- can be done in transaction after sendMessage, probably shouldn't
|
||||
msgId <- withStore $ \st -> createNewMessage st newMsg
|
||||
deliverMessage conn msgBody msgId
|
||||
|
||||
directMessage :: ChatMsgEvent -> ByteString
|
||||
directMessage chatMsgEvent =
|
||||
serializeRawChatMessage $
|
||||
rawChatMessage ChatMessage {chatMsgId = Nothing, chatMsgEvent, chatDAG = Nothing}
|
||||
directMessage chatMsgEvent = strEncode ChatMessage {chatMsgEvent}
|
||||
|
||||
deliverMessage :: ChatMonad m => Connection -> MsgBody -> MessageId -> m ()
|
||||
deliverMessage Connection {connId, agentConnId} msgBody msgId = do
|
||||
@@ -1124,7 +1119,7 @@ deliverMessage Connection {connId, agentConnId} msgBody msgId = do
|
||||
sendGroupMessage :: ChatMonad m => [GroupMember] -> ChatMsgEvent -> m ()
|
||||
sendGroupMessage members chatMsgEvent = do
|
||||
let msgBody = directMessage chatMsgEvent
|
||||
newMsg = NewMessage {direction = MDSnd, chatMsgEventType = toChatEventType chatMsgEvent, msgBody}
|
||||
newMsg = NewMessage {direction = MDSnd, chatMsgEventType = toChatEventTag chatMsgEvent, msgBody}
|
||||
msgId <- withStore $ \st -> createNewMessage st newMsg
|
||||
-- TODO once scheduled delivery is implemented memberActive should be changed to memberCurrent
|
||||
forM_ (map memberConn $ filter memberActive members) $
|
||||
@@ -1133,7 +1128,7 @@ sendGroupMessage members chatMsgEvent = do
|
||||
saveRcvMSG :: ChatMonad m => Connection -> MsgMeta -> MsgBody -> m ChatMsgEvent
|
||||
saveRcvMSG Connection {connId} agentMsgMeta msgBody = do
|
||||
ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage msgBody
|
||||
let newMsg = NewMessage {direction = MDRcv, chatMsgEventType = toChatEventType chatMsgEvent, msgBody}
|
||||
let newMsg = NewMessage {direction = MDRcv, chatMsgEventType = toChatEventTag chatMsgEvent, msgBody}
|
||||
agentMsgId = fst $ recipient agentMsgMeta
|
||||
rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta}
|
||||
withStore $ \st -> createNewMessageAndRcvMsgDelivery st newMsg rcvMsgDelivery
|
||||
@@ -1241,7 +1236,7 @@ chatCommandP =
|
||||
<|> ("/groups" <|> "/gs") $> ListGroups
|
||||
<|> A.char '#' *> (SendGroupMessage <$> displayName <* A.space <*> A.takeByteString)
|
||||
<|> ("/contacts" <|> "/cs") $> ListContacts
|
||||
<|> ("/connect " <|> "/c ") *> (Connect <$> ((Just <$> connReqP) <|> A.takeByteString $> Nothing))
|
||||
<|> ("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeByteString $> Nothing))
|
||||
<|> ("/connect" <|> "/c") $> AddContact
|
||||
<|> ("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> displayName)
|
||||
<|> A.char '@' *> (SendMessage <$> displayName <*> (A.space *> A.takeByteString))
|
||||
@@ -1251,7 +1246,7 @@ chatCommandP =
|
||||
<|> ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal)
|
||||
<|> ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal)
|
||||
<|> "/admin_welcome " *> (SendAdminWelcome <$> displayName)
|
||||
<|> "/admin" $> ConnectAdmin
|
||||
-- <|> "/admin" $> ConnectAdmin
|
||||
<|> ("/address" <|> "/ad") $> CreateMyAddress
|
||||
<|> ("/delete_address" <|> "/da") $> DeleteMyAddress
|
||||
<|> ("/show_address" <|> "/sa") $> ShowMyAddress
|
||||
@@ -1284,6 +1279,6 @@ chatCommandP =
|
||||
<|> (" member" $> GRMember)
|
||||
<|> pure GRAdmin
|
||||
|
||||
adminContactReq :: ConnectionRequest 'CMContact
|
||||
adminContactReq =
|
||||
either error id $ parseAll connReqP' "https://simplex.chat/contact#/?smp=smp%3A%2F%2Fnxc7HnrnM8dOKgkMp008ub_9o9LXJlxlMrMpR-mfMQw%3D%40smp3.simplex.im%2F-TXnePw5eH5-4L7B%23&e2e=rsa%3AMIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEA6vpcsZggnYL38Qa2G5YU0W5uqnV8WAq_S3flIFU2kx4qW-aokVT8fo0CLJXv9aagdHObFfhc9SXcZPcm4T2NLnafKTgQa_HYFfj764l6cHkbSI-4JBE1gyhtaapsvrDGIdoiGDLgsF3AJVjqs8gavkuTsmw035aWMH-pkpc4qGlEWpNWp1Nn-7O4sdIIQ7yN48jsdCfeIY-BIk3kFR6s4oQOgiOcnir8e3x5tTuRMX1KWSiuzuqLHqgmcI1IqcPJPrBoTQLbXXEMGG1RsvIudxR03jejXXbQvlxXlNNrxwkniEe-P0rApGuCyv2NRMb4n0Wd3ZwewH7X-xtr16XNbQKBgDouGUHD1C55jB-w8W8VJRhFZS2xIYka9gJH1jjCFxHFzgjo69A_sObIamND1pF_JOzj_XCoA1fDICF95XbfS0rq9iS6xvX6M8Muq8QiJsfD5bRt5nh-Y3GK5rAFXS0ZtyOeh07iMLAMJ_EFxBQuKKDRu9_9KAvLL_plU0PuaMH3"
|
||||
-- adminContactReq :: ConnReqContact
|
||||
-- adminContactReq =
|
||||
-- either error id $ parseAll connReqP' "https://simplex.chat/contact#/?smp=smp%3A%2F%2Fnxc7HnrnM8dOKgkMp008ub_9o9LXJlxlMrMpR-mfMQw%3D%40smp3.simplex.im%2F-TXnePw5eH5-4L7B%23&e2e=rsa%3AMIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEA6vpcsZggnYL38Qa2G5YU0W5uqnV8WAq_S3flIFU2kx4qW-aokVT8fo0CLJXv9aagdHObFfhc9SXcZPcm4T2NLnafKTgQa_HYFfj764l6cHkbSI-4JBE1gyhtaapsvrDGIdoiGDLgsF3AJVjqs8gavkuTsmw035aWMH-pkpc4qGlEWpNWp1Nn-7O4sdIIQ7yN48jsdCfeIY-BIk3kFR6s4oQOgiOcnir8e3x5tTuRMX1KWSiuzuqLHqgmcI1IqcPJPrBoTQLbXXEMGG1RsvIudxR03jejXXbQvlxXlNNrxwkniEe-P0rApGuCyv2NRMb4n0Wd3ZwewH7X-xtr16XNbQKBgDouGUHD1C55jB-w8W8VJRhFZS2xIYka9gJH1jjCFxHFzgjo69A_sObIamND1pF_JOzj_XCoA1fDICF95XbfS0rq9iS6xvX6M8Muq8QiJsfD5bRt5nh-Y3GK5rAFXS0ZtyOeh07iMLAMJ_EFxBQuKKDRu9_9KAvLL_plU0PuaMH3"
|
||||
|
||||
Reference in New Issue
Block a user