Merge branch 'master' into remote-desktop

This commit is contained in:
Evgeny Poberezkin 2023-11-18 18:03:13 +00:00
commit cc434cda55
20 changed files with 934 additions and 341 deletions

View File

@ -29,10 +29,6 @@ import java.io.File
val simplexWindowState = SimplexWindowState() val simplexWindowState = SimplexWindowState()
fun showApp() = application { fun showApp() = application {
// TODO: remove after update to compose 1.5.0+
// See: https://github.com/JetBrains/compose-multiplatform/issues/3366#issuecomment-1643799976
System.setProperty("compose.scrolling.smooth.enabled", "false")
// For some reason on Linux actual width will be 10.dp less after specifying it here. If we specify 1366, // For some reason on Linux actual width will be 10.dp less after specifying it here. If we specify 1366,
// it will show 1356. But after that we can still update it to 1366 by changing window state. Just making it +10 now here // it will show 1356. But after that we can still update it to 1366 by changing window state. Just making it +10 now here
val width = if (desktopPlatform.isLinux()) 1376.dp else 1366.dp val width = if (desktopPlatform.isLinux()) 1376.dp else 1366.dp

View File

@ -122,6 +122,7 @@ library
Simplex.Chat.Migrations.M20231019_indexes Simplex.Chat.Migrations.M20231019_indexes
Simplex.Chat.Migrations.M20231030_xgrplinkmem_received Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
Simplex.Chat.Migrations.M20231107_indexes Simplex.Chat.Migrations.M20231107_indexes
Simplex.Chat.Migrations.M20231113_group_forward
Simplex.Chat.Migrations.M20231114_remote_controller Simplex.Chat.Migrations.M20231114_remote_controller
Simplex.Chat.Mobile Simplex.Chat.Mobile
Simplex.Chat.Mobile.File Simplex.Chat.Mobile.File

View File

@ -32,6 +32,7 @@ import Data.Bifunctor (bimap, first)
import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (ByteString) import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Char import Data.Char
import Data.Constraint (Dict (..)) import Data.Constraint (Dict (..))
import Data.Either (fromRight, rights) import Data.Either (fromRight, rights)
@ -149,7 +150,8 @@ defaultChatConfig =
cleanupManagerInterval = 30 * 60, -- 30 minutes cleanupManagerInterval = 30 * 60, -- 30 minutes
cleanupManagerStepDelay = 3 * 1000000, -- 3 seconds cleanupManagerStepDelay = 3 * 1000000, -- 3 seconds
ciExpirationInterval = 30 * 60 * 1000000, -- 30 minutes ciExpirationInterval = 30 * 60 * 1000000, -- 30 minutes
coreApi = False coreApi = False,
highlyAvailable = False
} }
_defaultSMPServers :: NonEmpty SMPServerWithAuth _defaultSMPServers :: NonEmpty SMPServerWithAuth
@ -193,9 +195,9 @@ createChatDatabase filePrefix key confirmMigrations = runExceptT $ do
pure ChatDatabase {chatStore, agentStore} pure ChatDatabase {chatStore, agentStore}
newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> IO ChatController newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> IO ChatController
newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize} = do newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable}, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize} = do
let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False} let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize} config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable}
firstTime = dbNew chatStore firstTime = dbNew chatStore
currentUser <- newTVarIO user currentUser <- newTVarIO user
currentRemoteHost <- newTVarIO Nothing currentRemoteHost <- newTVarIO Nothing
@ -1609,7 +1611,7 @@ processChatCommand = \case
gVar <- asks idsDrg gVar <- asks idsDrg
subMode <- chatReadVar subscriptionMode subMode <- chatReadVar subscriptionMode
(agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode (agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode
member <- withStore $ \db -> createNewContactMember db gVar user groupId contact memRole agentConnId cReq subMode member <- withStore $ \db -> createNewContactMember db gVar user gInfo contact memRole agentConnId cReq subMode
sendInvitation member cReq sendInvitation member cReq
pure $ CRSentGroupInvitation user gInfo contact member pure $ CRSentGroupInvitation user gInfo contact member
Just member@GroupMember {groupMemberId, memberStatus, memberRole = mRole} Just member@GroupMember {groupMemberId, memberStatus, memberRole = mRole}
@ -3273,7 +3275,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
MSG meta _msgFlags msgBody -> do MSG meta _msgFlags msgBody -> do
cmdId <- createAckCmd conn cmdId <- createAckCmd conn
withAckMessage agentConnId cmdId meta $ do withAckMessage agentConnId cmdId meta $ do
(_conn', _) <- saveRcvMSG conn (ConnectionId connId) meta msgBody cmdId (_conn', _) <- saveDirectRcvMSG conn meta cmdId msgBody
pure False pure False
SENT msgId -> SENT msgId ->
sentMsgDeliveryEvent conn msgId sentMsgDeliveryEvent conn msgId
@ -3304,14 +3306,13 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
MSG msgMeta _msgFlags msgBody -> do MSG msgMeta _msgFlags msgBody -> do
cmdId <- createAckCmd conn cmdId <- createAckCmd conn
withAckMessage agentConnId cmdId msgMeta $ do withAckMessage agentConnId cmdId msgMeta $ do
(conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveRcvMSG conn (ConnectionId connId) msgMeta msgBody cmdId (conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveDirectRcvMSG conn msgMeta cmdId msgBody
let ct' = ct {activeConn = Just conn'} :: Contact let ct' = ct {activeConn = Just conn'} :: Contact
assertDirectAllowed user MDRcv ct' $ toCMEventTag event assertDirectAllowed user MDRcv ct' $ toCMEventTag event
updateChatLock "directMessage" event updateChatLock "directMessage" event
case event of case event of
XMsgNew mc -> newContentMessage ct' mc msg msgMeta XMsgNew mc -> newContentMessage ct' mc msg msgMeta
XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct' sharedMsgId fileDescr msgMeta XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct' sharedMsgId fileDescr msgMeta
XMsgFileCancel sharedMsgId -> cancelMessageFile ct' sharedMsgId msgMeta
XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct' sharedMsgId mContent msg msgMeta ttl live XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct' sharedMsgId mContent msg msgMeta ttl live
XMsgDel sharedMsgId _ -> messageDelete ct' sharedMsgId msg msgMeta XMsgDel sharedMsgId _ -> messageDelete ct' sharedMsgId msg msgMeta
XMsgReact sharedMsgId _ reaction add -> directMsgReaction ct' sharedMsgId reaction add msg msgMeta XMsgReact sharedMsgId _ reaction add -> directMsgReaction ct' sharedMsgId reaction add msg msgMeta
@ -3388,10 +3389,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc)
toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci) toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
forM_ groupId_ $ \groupId -> do forM_ groupId_ $ \groupId -> do
groupInfo <- withStore $ \db -> getGroupInfo db user groupId
subMode <- chatReadVar subscriptionMode subMode <- chatReadVar subscriptionMode
gVar <- asks idsDrg
groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
withStore $ \db -> createNewContactMemberAsync db gVar user groupId ct gLinkMemRole groupConnIds (fromJVersionRange peerChatVRange) subMode gVar <- asks idsDrg
withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct gLinkMemRole groupConnIds (fromJVersionRange peerChatVRange) subMode
_ -> pure () _ -> pure ()
Just (gInfo, m@GroupMember {activeConn}) -> Just (gInfo, m@GroupMember {activeConn}) ->
when (maybe False ((== ConnReady) . connStatus) activeConn) $ do when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
@ -3561,62 +3563,118 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
withStore' $ \db -> updateIntroStatus db introId GMIntroSent withStore' $ \db -> updateIntroStatus db introId GMIntroSent
_ -> do _ -> do
-- TODO notify member who forwarded introduction - question - where it is stored? There is via_contact but probably there should be via_member in group_members table -- TODO notify member who forwarded introduction - question - where it is stored? There is via_contact but probably there should be via_member in group_members table
let memCategory = memberCategory m
withStore' (\db -> getViaGroupContact db user m) >>= \case withStore' (\db -> getViaGroupContact db user m) >>= \case
Nothing -> do Nothing -> do
notifyMemberConnected gInfo m Nothing notifyMemberConnected gInfo m Nothing
let connectedIncognito = memberIncognito membership let connectedIncognito = memberIncognito membership
when (memberCategory m == GCPreMember) $ probeMatchingMemberContact m connectedIncognito when (memCategory == GCPreMember) $ probeMatchingMemberContact m connectedIncognito
Just ct@Contact {activeConn} -> Just ct@Contact {activeConn} ->
forM_ activeConn $ \Connection {connStatus} -> forM_ activeConn $ \Connection {connStatus} ->
when (connStatus == ConnReady) $ do when (connStatus == ConnReady) $ do
notifyMemberConnected gInfo m $ Just ct notifyMemberConnected gInfo m $ Just ct
let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True when (memCategory == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True
sendXGrpMemCon memCategory
where
sendXGrpMemCon = \case
GCPreMember ->
forM_ (invitedByGroupMemberId membership) $ \hostId -> do
host <- withStore $ \db -> getGroupMember db user groupId hostId
forM_ (memberConn host) $ \hostConn ->
void $ sendDirectMessage hostConn (XGrpMemCon m.memberId) (GroupId groupId)
GCPostMember ->
forM_ (invitedByGroupMemberId m) $ \invitingMemberId -> do
im <- withStore $ \db -> getGroupMember db user groupId invitingMemberId
forM_ (memberConn im) $ \imConn ->
void $ sendDirectMessage imConn (XGrpMemCon m.memberId) (GroupId groupId)
_ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected"
MSG msgMeta _msgFlags msgBody -> do MSG msgMeta _msgFlags msgBody -> do
cmdId <- createAckCmd conn cmdId <- createAckCmd conn
withAckMessage agentConnId cmdId msgMeta $ do tryChatError (processChatMessage cmdId) >>= \case
(conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveRcvMSG conn (GroupId groupId) msgMeta msgBody cmdId Right (ACMsg _ chatMsg, withRcpt) -> do
let m' = m {activeConn = Just conn'} :: GroupMember ackMsg agentConnId cmdId msgMeta $ if withRcpt then Just "" else Nothing
updateChatLock "groupMessage" event when (membership.memberRole >= GRAdmin) $ forwardMsg_ chatMsg
case event of Left e -> ackMsg agentConnId cmdId msgMeta Nothing >> throwError e
XMsgNew mc -> canSend m' $ newGroupContentMessage gInfo m' mc msg msgMeta
XMsgFileDescr sharedMsgId fileDescr -> canSend m' $ groupMessageFileDescription gInfo m' sharedMsgId fileDescr msgMeta
XMsgFileCancel sharedMsgId -> cancelGroupMessageFile gInfo m' sharedMsgId msgMeta
XMsgUpdate sharedMsgId mContent ttl live -> canSend m' $ groupMessageUpdate gInfo m' sharedMsgId mContent msg msgMeta ttl live
XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m' sharedMsgId memberId msg msgMeta
XMsgReact sharedMsgId (Just memberId) reaction add -> groupMsgReaction gInfo m' sharedMsgId memberId reaction add msg msgMeta
-- TODO discontinue XFile
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
-- XInfo p -> xInfoMember gInfo m' p -- TODO use for member profile update
XGrpLinkMem p -> xGrpLinkMem gInfo m' conn' p
XGrpMemNew memInfo -> xGrpMemNew gInfo m' memInfo msg msgMeta
XGrpMemIntro memInfo -> xGrpMemIntro gInfo m' memInfo
XGrpMemInv memId introInv -> xGrpMemInv gInfo m' memId introInv
XGrpMemFwd memInfo introInv -> xGrpMemFwd gInfo m' memInfo introInv
XGrpMemRole memId memRole -> xGrpMemRole gInfo m' memId memRole msg msgMeta
XGrpMemDel memId -> xGrpMemDel gInfo m' memId msg msgMeta
XGrpLeave -> xGrpLeave gInfo m' msg msgMeta
XGrpDel -> xGrpDel gInfo m' msg msgMeta
XGrpInfo p' -> xGrpInfo gInfo m' p' msg msgMeta
XGrpDirectInv connReq mContent_ -> canSend m' $ xGrpDirectInv gInfo m' conn' connReq mContent_ msg msgMeta
XInfoProbe probe -> xInfoProbe (COMGroupMember m') probe
XInfoProbeCheck probeHash -> xInfoProbeCheck (COMGroupMember m') probeHash
XInfoProbeOk probe -> xInfoProbeOk (COMGroupMember m') probe
BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta
_ -> messageError $ "unsupported message: " <> T.pack (show event)
currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
let GroupInfo {chatSettings = ChatSettings {sendRcpts}} = gInfo
pure $
fromMaybe (sendRcptsSmallGroups user) sendRcpts
&& hasDeliveryReceipt (toCMEventTag event)
&& currentMemCount <= smallGroupsRcptsMemLimit
where where
canSend :: GroupMember -> m () -> m () processChatMessage :: Int64 -> m (AChatMessage, Bool)
canSend mem a processChatMessage cmdId = do
| mem.memberRole <= GRObserver = messageError "member is not allowed to send messages" msg@(ACMsg _ chatMsg) <- parseAChatMessage conn msgMeta msgBody
| otherwise = a checkIntegrity chatMsg `catchChatError` \_ -> pure ()
(msg,) <$> processEvent cmdId chatMsg
brokerTs = metaBrokerTs msgMeta
checkIntegrity :: ChatMessage e -> m ()
checkIntegrity ChatMessage {chatMsgEvent} = do
when checkForEvent $ checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
where
checkForEvent = case chatMsgEvent of
XMsgNew _ -> True
XFileCancel _ -> True
XFileAcptInv {} -> True
XGrpMemNew _ -> True
XGrpMemRole {} -> True
XGrpMemDel _ -> True
XGrpLeave -> True
XGrpDel -> True
XGrpInfo _ -> True
XGrpDirectInv {} -> True
_ -> False
processEvent :: MsgEncodingI e => CommandId -> ChatMessage e -> m Bool
processEvent cmdId chatMsg = do
(m', conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m conn msgMeta cmdId msgBody chatMsg
updateChatLock "groupMessage" event
case event of
XMsgNew mc -> memberCanSend m' $ newGroupContentMessage gInfo m' mc msg brokerTs
XMsgFileDescr sharedMsgId fileDescr -> memberCanSend m' $ groupMessageFileDescription gInfo m' sharedMsgId fileDescr
XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend m' $ groupMessageUpdate gInfo m' sharedMsgId mContent 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
XFile fInv -> processGroupFileInvitation' gInfo m' fInv msg brokerTs
XFileCancel sharedMsgId -> xFileCancelGroup gInfo m' sharedMsgId
XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInvGroup gInfo m' sharedMsgId fileConnReq_ fName
XInfo p -> xInfoMember gInfo m' p
XGrpLinkMem p -> xGrpLinkMem gInfo m' conn' p
XGrpMemNew memInfo -> xGrpMemNew gInfo m' memInfo msg brokerTs
XGrpMemIntro memInfo -> xGrpMemIntro gInfo m' memInfo
XGrpMemInv memId introInv -> xGrpMemInv gInfo m' memId introInv
XGrpMemFwd memInfo introInv -> xGrpMemFwd gInfo m' memInfo introInv
XGrpMemRole memId memRole -> xGrpMemRole gInfo m' memId memRole msg brokerTs
XGrpMemCon memId -> xGrpMemCon gInfo m' memId
XGrpMemDel memId -> xGrpMemDel gInfo m' memId msg brokerTs
XGrpLeave -> xGrpLeave gInfo m' msg brokerTs
XGrpDel -> xGrpDel gInfo m' msg brokerTs
XGrpInfo p' -> xGrpInfo gInfo m' p' msg brokerTs
XGrpDirectInv connReq mContent_ -> memberCanSend m' $ 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
XInfoProbeOk probe -> xInfoProbeOk (COMGroupMember m') probe
BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta
_ -> messageError $ "unsupported message: " <> T.pack (show event)
checkSendRcpt event
checkSendRcpt :: ChatMsgEvent e -> m Bool
checkSendRcpt event = do
currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
let GroupInfo {chatSettings = ChatSettings {sendRcpts}} = gInfo
pure $
fromMaybe (sendRcptsSmallGroups user) sendRcpts
&& hasDeliveryReceipt (toCMEventTag event)
&& currentMemCount <= smallGroupsRcptsMemLimit
forwardMsg_ :: MsgEncodingI e => ChatMessage e -> m ()
forwardMsg_ chatMsg =
forM_ (forwardedGroupMsg chatMsg) $ \chatMsg' -> do
ChatConfig {highlyAvailable} <- asks config
-- members introduced to this invited member
introducedMembers <- if memberCategory m == GCInviteeMember
then withStore' $ \db -> getForwardIntroducedMembers db user m highlyAvailable
else pure []
-- invited members to which this member was introduced
invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db user m highlyAvailable
let ms = introducedMembers <> invitedMembers
msg = XGrpMsgForward m.memberId chatMsg' brokerTs
unless (null ms) $
void $ sendGroupMessage user gInfo ms msg
RCVD msgMeta msgRcpt -> RCVD msgMeta msgRcpt ->
withAckMessage' agentConnId conn msgMeta $ withAckMessage' agentConnId conn msgMeta $
groupMsgReceived gInfo m conn msgMeta msgRcpt groupMsgReceived gInfo m conn msgMeta msgRcpt
@ -3875,6 +3933,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
_ -> toView $ CRReceivedContactRequest user cReq _ -> toView $ CRReceivedContactRequest user cReq
_ -> pure () _ -> pure ()
memberCanSend :: GroupMember -> m () -> m ()
memberCanSend mem a
| mem.memberRole <= GRObserver = messageError "member is not allowed to send messages"
| otherwise = a
incAuthErrCounter :: ConnectionEntity -> Connection -> AgentErrorType -> m () incAuthErrCounter :: ConnectionEntity -> Connection -> AgentErrorType -> m ()
incAuthErrCounter connEntity conn err = do incAuthErrCounter connEntity conn err = do
case err of case err of
@ -3918,7 +3981,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
withAckMessage cId cmdId msgMeta $ action $> False withAckMessage cId cmdId msgMeta $ action $> False
withAckMessage :: ConnId -> CommandId -> MsgMeta -> m Bool -> m () withAckMessage :: ConnId -> CommandId -> MsgMeta -> m Bool -> m ()
withAckMessage cId cmdId MsgMeta {recipient = (msgId, _)} action = do withAckMessage cId cmdId msgMeta action = do
-- [async agent commands] command should be asynchronous, continuation is ackMsgDeliveryEvent -- [async agent commands] command should be asynchronous, continuation is ackMsgDeliveryEvent
-- TODO catching error and sending ACK after an error, particularly if it is a database error, will result in the message not processed (and no notification to the user). -- TODO catching error and sending ACK after an error, particularly if it is a database error, will result in the message not processed (and no notification to the user).
-- Possible solutions are: -- Possible solutions are:
@ -3926,10 +3989,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- 2) stabilize database -- 2) stabilize database
-- 3) show screen of death to the user asking to restart -- 3) show screen of death to the user asking to restart
tryChatError action >>= \case tryChatError action >>= \case
Right withRcpt -> ack $ if withRcpt then Just "" else Nothing Right withRcpt -> ackMsg cId cmdId msgMeta $ if withRcpt then Just "" else Nothing
Left e -> ack Nothing >> throwError e Left e -> ackMsg cId cmdId msgMeta Nothing >> throwError e
where
ack rcpt = withAgent $ \a -> ackMessageAsync a (aCorrId cmdId) cId msgId rcpt ackMsg :: ConnId -> CommandId -> MsgMeta -> Maybe MsgReceiptInfo -> m ()
ackMsg cId cmdId MsgMeta {recipient = (msgId, _)} rcpt = withAgent $ \a -> ackMessageAsync a (aCorrId cmdId) cId msgId rcpt
ackMsgDeliveryEvent :: Connection -> CommandId -> m () ackMsgDeliveryEvent :: Connection -> CommandId -> m ()
ackMsgDeliveryEvent Connection {connId} ackCmdId = ackMsgDeliveryEvent Connection {connId} ackCmdId =
@ -4049,8 +4113,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live
autoAcceptFile file_ autoAcceptFile file_
where where
brokerTs = metaBrokerTs msgMeta
newChatItem ciContent ciFile_ timed_ live = do newChatItem ciContent ciFile_ timed_ live = do
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live
reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getDirectCIReactions db ct sharedMsgId) sharedMsgId_ reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getDirectCIReactions db ct sharedMsgId) sharedMsgId_
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions}) toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions})
@ -4065,8 +4130,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId
processFDMessage fileId fileDescr processFDMessage fileId fileDescr
groupMessageFileDescription :: GroupInfo -> GroupMember -> SharedMsgId -> FileDescr -> MsgMeta -> m () groupMessageFileDescription :: GroupInfo -> GroupMember -> SharedMsgId -> FileDescr -> m ()
groupMessageFileDescription GroupInfo {groupId} _m sharedMsgId fileDescr _msgMeta = do groupMessageFileDescription GroupInfo {groupId} _m sharedMsgId fileDescr = do
fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
processFDMessage fileId fileDescr processFDMessage fileId fileDescr
@ -4084,17 +4149,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
(RFSAccepted _, Just XFTPRcvFile {}) -> receiveViaCompleteFD user fileId rfd cryptoArgs (RFSAccepted _, Just XFTPRcvFile {}) -> receiveViaCompleteFD user fileId rfd cryptoArgs
_ -> pure () _ -> pure ()
cancelMessageFile :: Contact -> SharedMsgId -> MsgMeta -> m ()
cancelMessageFile ct _sharedMsgId msgMeta = do
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
-- find the original chat item and file
-- mark file as cancelled, remove description if exists
pure ()
cancelGroupMessageFile :: GroupInfo -> GroupMember -> SharedMsgId -> MsgMeta -> m ()
cancelGroupMessageFile _gInfo _m _sharedMsgId _msgMeta = do
pure ()
processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer) -> m (Maybe (RcvFileTransfer, CIFile 'MDRcv)) processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer) -> m (Maybe (RcvFileTransfer, CIFile 'MDRcv))
processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do
ChatConfig {fileChunkSize} <- asks config ChatConfig {fileChunkSize} <- asks config
@ -4121,13 +4175,13 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete). -- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete).
-- Chat item and update message which created it will have different sharedMsgId in this case... -- Chat item and update message which created it will have different sharedMsgId in this case...
let timed_ = rcvContactCITimed ct ttl let timed_ = rcvContactCITimed ct ttl
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta content Nothing timed_ live ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) brokerTs content Nothing timed_ live
ci' <- withStore' $ \db -> do ci' <- withStore' $ \db -> do
createChatItemVersion db (chatItemId' ci) brokerTs mc createChatItemVersion db (chatItemId' ci) brokerTs mc
updateDirectChatItem' db user contactId ci content live Nothing updateDirectChatItem' db user contactId ci content live Nothing
toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci')
where where
MsgMeta {broker = (_, brokerTs)} = msgMeta brokerTs = metaBrokerTs msgMeta
content = CIRcvMsgContent mc content = CIRcvMsgContent mc
live = fromMaybe False live_ live = fromMaybe False live_
updateRcvChatItem = do updateRcvChatItem = do
@ -4182,8 +4236,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
else pure Nothing else pure Nothing
mapM_ toView cr_ mapM_ toView cr_
groupMsgReaction :: GroupInfo -> GroupMember -> SharedMsgId -> MemberId -> MsgReaction -> Bool -> RcvMessage -> MsgMeta -> m () groupMsgReaction :: GroupInfo -> GroupMember -> SharedMsgId -> MemberId -> MsgReaction -> Bool -> RcvMessage -> UTCTime -> m ()
groupMsgReaction g@GroupInfo {groupId} m sharedMsgId itemMemberId reaction add RcvMessage {msgId} MsgMeta {broker = (_, brokerTs)} = do groupMsgReaction g@GroupInfo {groupId} m sharedMsgId itemMemberId reaction add RcvMessage {msgId} brokerTs = do
when (groupFeatureAllowed SGFReactions g) $ do when (groupFeatureAllowed SGFReactions g) $ do
rs <- withStore' $ \db -> getGroupReactions db g m itemMemberId sharedMsgId False rs <- withStore' $ \db -> getGroupReactions db g m itemMemberId sharedMsgId False
when (reactionAllowed add reaction rs) $ do when (reactionAllowed add reaction rs) $ do
@ -4212,8 +4266,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
ChatErrorStore (SEChatItemSharedMsgIdNotFound sharedMsgId) -> handle sharedMsgId ChatErrorStore (SEChatItemSharedMsgIdNotFound sharedMsgId) -> handle sharedMsgId
e -> throwError e e -> throwError e
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m () newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> m ()
newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} msgMeta newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs
| isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice | isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
| not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles | not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
| otherwise = do | otherwise = do
@ -4233,38 +4287,37 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
| moderatorRole < GRAdmin || moderatorRole < memberRole = | moderatorRole < GRAdmin || moderatorRole < memberRole =
createItem timed_ live createItem timed_ live
| groupFeatureAllowed SGFFullDelete gInfo = do | groupFeatureAllowed SGFFullDelete gInfo = do
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta CIRcvModerated Nothing timed_ False ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed_ False
ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt
toView $ CRNewChatItem user $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci' toView $ CRNewChatItem user $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci'
| otherwise = do | otherwise = do
file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent content) (snd <$> file_) timed_ False ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content) (snd <$> file_) timed_ False
toView =<< markGroupCIDeleted user gInfo ci createdByMsgId False (Just moderator) moderatedAt toView =<< markGroupCIDeleted user gInfo ci createdByMsgId False (Just moderator) moderatedAt
createItem timed_ live = do createItem timed_ live = do
file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live
when (showMessages $ memberSettings m) $ autoAcceptFile file_ when (showMessages $ memberSettings m) $ autoAcceptFile file_
newChatItem ciContent ciFile_ timed_ live = do newChatItem ciContent ciFile_ timed_ live = do
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live
ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci
reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_ reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_
groupMsgToView gInfo m ci' {reactions} msgMeta groupMsgToView gInfo ci' {reactions}
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m () groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> UTCTime -> Maybe Int -> Maybe Bool -> m ()
groupMessageUpdate gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl_ live_ = groupMessageUpdate gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} brokerTs ttl_ live_ =
updateRcvChatItem `catchCINotFound` \_ -> do updateRcvChatItem `catchCINotFound` \_ -> do
-- This patches initial sharedMsgId into chat item when locally deleted chat item -- This patches initial sharedMsgId into chat item when locally deleted chat item
-- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete). -- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete).
-- Chat item and update message which created it will have different sharedMsgId in this case... -- Chat item and update message which created it will have different sharedMsgId in this case...
let timed_ = rcvGroupCITimed gInfo ttl_ let timed_ = rcvGroupCITimed gInfo ttl_
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta content Nothing timed_ live ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) brokerTs content Nothing timed_ live
ci' <- withStore' $ \db -> do ci' <- withStore' $ \db -> do
createChatItemVersion db (chatItemId' ci) brokerTs mc createChatItemVersion db (chatItemId' ci) brokerTs mc
ci' <- updateGroupChatItem db user groupId ci content live Nothing ci' <- updateGroupChatItem db user groupId ci content live Nothing
blockedMember m ci' $ markGroupChatItemBlocked db user gInfo ci' blockedMember m ci' $ markGroupChatItemBlocked db user gInfo ci'
toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
where where
MsgMeta {broker = (_, brokerTs)} = msgMeta
content = CIRcvMsgContent mc content = CIRcvMsgContent mc
live = fromMaybe False live_ live = fromMaybe False live_
updateRcvChatItem = do updateRcvChatItem = do
@ -4287,8 +4340,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
else messageError "x.msg.update: group member attempted to update a message of another member" else messageError "x.msg.update: group member attempted to update a message of another member"
_ -> messageError "x.msg.update: group member attempted invalid message update" _ -> messageError "x.msg.update: group member attempted invalid message update"
groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> MsgMeta -> m () groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> UTCTime -> m ()
groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} MsgMeta {broker = (_, brokerTs)} = do groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} brokerTs = do
let msgMemberId = fromMaybe memberId sndMemberId_ let msgMemberId = fromMaybe memberId sndMemberId_
withStore' (\db -> runExceptT $ getGroupMemberCIBySharedMsgId db user groupId msgMemberId sharedMsgId) >>= \case withStore' (\db -> runExceptT $ getGroupMemberCIBySharedMsgId db user groupId msgMemberId sharedMsgId) >>= \case
Right (CChatItem _ ci@ChatItem {chatDir}) -> case chatDir of Right (CChatItem _ ci@ChatItem {chatDir}) -> case chatDir of
@ -4325,20 +4378,22 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvFileTransfer db userId ct fInv inline fileChunkSize RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvFileTransfer db userId ct fInv inline fileChunkSize
let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP
ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol}
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs (CIRcvMsgContent $ MCFile "") ciFile Nothing False
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci)
where
brokerTs = metaBrokerTs msgMeta
-- TODO remove once XFile is discontinued -- TODO remove once XFile is discontinued
processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m () processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> UTCTime -> m ()
processGroupFileInvitation' gInfo m fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do processGroupFileInvitation' gInfo m fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} brokerTs = do
ChatConfig {fileChunkSize} <- asks config ChatConfig {fileChunkSize} <- asks config
inline <- receiveInlineMode fInv Nothing fileChunkSize inline <- receiveInlineMode fInv Nothing fileChunkSize
RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvGroupFileTransfer db userId m fInv inline fileChunkSize RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvGroupFileTransfer db userId m fInv inline fileChunkSize
let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP
ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol}
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent $ MCFile "") ciFile Nothing False
ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci
groupMsgToView gInfo m ci' msgMeta groupMsgToView gInfo ci'
blockedMember :: Monad m' => GroupMember -> ChatItem c d -> m' (ChatItem c d) -> m' (ChatItem c d) blockedMember :: Monad m' => GroupMember -> ChatItem c d -> m' (ChatItem c d) -> m' (ChatItem c d)
blockedMember m ci blockedCI blockedMember m ci blockedCI
@ -4445,9 +4500,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
_ -> pure () _ -> pure ()
receiveFileChunk ft Nothing meta chunk receiveFileChunk ft Nothing meta chunk
xFileCancelGroup :: GroupInfo -> GroupMember -> SharedMsgId -> MsgMeta -> m () xFileCancelGroup :: GroupInfo -> GroupMember -> SharedMsgId -> m ()
xFileCancelGroup g@GroupInfo {groupId} mem@GroupMember {groupMemberId, memberId} sharedMsgId msgMeta = do xFileCancelGroup GroupInfo {groupId} GroupMember {groupMemberId, memberId} sharedMsgId = do
checkIntegrityCreateItem (CDGroupRcv g mem) msgMeta
fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
CChatItem msgDir ChatItem {chatDir} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId CChatItem msgDir ChatItem {chatDir} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
case (msgDir, chatDir) of case (msgDir, chatDir) of
@ -4462,9 +4516,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
else messageError "x.file.cancel: group member attempted to cancel file of another member" -- shouldn't happen now that query includes group member id else messageError "x.file.cancel: group member attempted to cancel file of another member" -- shouldn't happen now that query includes group member id
(SMDSnd, _) -> messageError "x.file.cancel: group member attempted invalid file cancel" (SMDSnd, _) -> messageError "x.file.cancel: group member attempted invalid file cancel"
xFileAcptInvGroup :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe ConnReqInvitation -> String -> MsgMeta -> m () xFileAcptInvGroup :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe ConnReqInvitation -> String -> m ()
xFileAcptInvGroup g@GroupInfo {groupId} m@GroupMember {activeConn} sharedMsgId fileConnReq_ fName msgMeta = do xFileAcptInvGroup GroupInfo {groupId} m@GroupMember {activeConn} sharedMsgId fileConnReq_ fName = do
checkIntegrityCreateItem (CDGroupRcv g m) msgMeta
fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
(AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db user fileId (AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db user fileId
assertSMPAcceptNotProhibited ci assertSMPAcceptNotProhibited ci
@ -4493,9 +4546,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
_ -> messageError "x.file.acpt.inv: member connection is not active" _ -> messageError "x.file.acpt.inv: member connection is not active"
else messageError "x.file.acpt.inv: fileName is different from expected" else messageError "x.file.acpt.inv: fileName is different from expected"
groupMsgToView :: GroupInfo -> GroupMember -> ChatItem 'CTGroup 'MDRcv -> MsgMeta -> m () groupMsgToView :: GroupInfo -> ChatItem 'CTGroup 'MDRcv -> m ()
groupMsgToView gInfo m ci msgMeta = do groupMsgToView gInfo ci =
checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
toView $ CRNewChatItem user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci) toView $ CRNewChatItem user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci)
processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> m () processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> m ()
@ -4521,11 +4573,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct) toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct)
else do else do
let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content ci <- saveRcvChatItem user (CDDirectRcv ct) msg brokerTs content
withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci) withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci)
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci)
toView $ CRReceivedGroupInvitation {user, groupInfo = gInfo, contact = ct, fromMemberRole = fromRole, memberRole = memRole} toView $ CRReceivedGroupInvitation {user, groupInfo = gInfo, contact = ct, fromMemberRole = fromRole, memberRole = memRole}
where where
brokerTs = metaBrokerTs msgMeta
sameGroupLinkId :: Maybe GroupLinkId -> Maybe GroupLinkId -> Bool sameGroupLinkId :: Maybe GroupLinkId -> Maybe GroupLinkId -> Bool
sameGroupLinkId (Just gli) (Just gli') = gli == gli' sameGroupLinkId (Just gli) (Just gli') = gli == gli'
sameGroupLinkId _ _ = False sameGroupLinkId _ _ = False
@ -4549,13 +4602,15 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
forM_ contactConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted forM_ contactConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted
activeConn' <- forM (contactConn ct') $ \conn -> pure conn {connStatus = ConnDeleted} activeConn' <- forM (contactConn ct') $ \conn -> pure conn {connStatus = ConnDeleted}
let ct'' = ct' {activeConn = activeConn'} :: Contact let ct'' = ct' {activeConn = activeConn'} :: Contact
ci <- saveRcvChatItem user (CDDirectRcv ct'') msg msgMeta (CIRcvDirectEvent RDEContactDeleted) ci <- saveRcvChatItem user (CDDirectRcv ct'') msg brokerTs (CIRcvDirectEvent RDEContactDeleted)
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct'') ci) toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct'') ci)
toView $ CRContactDeletedByContact user ct'' toView $ CRContactDeletedByContact user ct''
else do else do
contactConns <- withStore' $ \db -> getContactConnections db userId c contactConns <- withStore' $ \db -> getContactConnections db userId c
deleteAgentConnectionsAsync user $ map aConnId contactConns deleteAgentConnectionsAsync user $ map aConnId contactConns
withStore' $ \db -> deleteContact db user c withStore' $ \db -> deleteContact db user c
where
brokerTs = metaBrokerTs msgMeta
processContactProfileUpdate :: Contact -> Profile -> Bool -> m Contact processContactProfileUpdate :: Contact -> Profile -> Bool -> m Contact
processContactProfileUpdate c@Contact {profile = p} p' createItems processContactProfileUpdate c@Contact {profile = p} p' createItems
@ -4586,9 +4641,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
| otherwise -> Nothing | otherwise -> Nothing
in setPreference_ SCFTimedMessages ctUserTMPref' ctUserPrefs in setPreference_ SCFTimedMessages ctUserTMPref' ctUserPrefs
-- TODO use for member profile update xInfoMember :: GroupInfo -> GroupMember -> Profile -> m ()
-- xInfoMember :: GroupInfo -> GroupMember -> Profile -> m () xInfoMember gInfo m p' = void $ processMemberProfileUpdate gInfo m p'
-- xInfoMember gInfo m p' = void $ processMemberProfileUpdate gInfo m p'
xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> m () xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> m ()
xGrpLinkMem gInfo@GroupInfo {membership} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' = do xGrpLinkMem gInfo@GroupInfo {membership} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' = do
@ -4720,9 +4774,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
toView $ CRNewChatItem user $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci toView $ CRNewChatItem user $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
else featureRejected CFCalls else featureRejected CFCalls
where where
saveCallItem status = saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvCall status 0) brokerTs = metaBrokerTs msgMeta
saveCallItem status = saveRcvChatItem user (CDDirectRcv ct) msg brokerTs (CIRcvCall status 0)
featureRejected f = do featureRejected f = do
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta (CIRcvChatFeatureRejected f) Nothing Nothing False ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs (CIRcvChatFeatureRejected f) Nothing Nothing False
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci)
-- to party initiating call -- to party initiating call
@ -4881,21 +4936,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- TODO show/log error, other events in SMP confirmation -- TODO show/log error, other events in SMP confirmation
_ -> pure conn' _ -> pure conn'
xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> RcvMessage -> MsgMeta -> m () xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> RcvMessage -> UTCTime -> m ()
xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ memberProfile) msg msgMeta = do xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ memberProfile) msg brokerTs = do
checkHostRole m memRole checkHostRole m memRole
members <- withStore' $ \db -> getGroupMembers db user gInfo members <- withStore' $ \db -> getGroupMembers db user gInfo
unless (sameMemberId memId $ membership gInfo) $ unless (sameMemberId memId $ membership gInfo) $
if isMember memId gInfo members if isMember memId gInfo members
then messageError "x.grp.mem.new error: member already exists" then messageError "x.grp.mem.new error: member already exists"
else do else do
newMember@GroupMember {groupMemberId} <- withStore $ \db -> createNewGroupMember db user gInfo memInfo GCPostMember GSMemAnnounced newMember@GroupMember {groupMemberId} <- withStore $ \db -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile) ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile)
groupMsgToView gInfo m ci msgMeta groupMsgToView gInfo ci
toView $ CRJoinedGroupMemberConnecting user gInfo m newMember toView $ CRJoinedGroupMemberConnecting user gInfo m newMember
xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> m () xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> m ()
xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memberChatVRange _) = do xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) = do
case memberCategory m of case memberCategory m of
GCHostMember -> do GCHostMember -> do
members <- withStore' $ \db -> getGroupMembers db user gInfo members <- withStore' $ \db -> getGroupMembers db user gInfo
@ -4906,7 +4961,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
subMode <- chatReadVar subscriptionMode subMode <- chatReadVar subscriptionMode
-- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second -- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second
groupConnIds <- createConn subMode groupConnIds <- createConn subMode
directConnIds <- case memberChatVRange of directConnIds <- case memChatVRange of
Nothing -> Just <$> createConn subMode Nothing -> Just <$> createConn subMode
Just mcvr Just mcvr
| isCompatibleRange (fromChatVRange mcvr) groupNoDirectVRange -> pure Nothing | isCompatibleRange (fromChatVRange mcvr) groupNoDirectVRange -> pure Nothing
@ -4938,7 +4993,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
_ -> messageError "x.grp.mem.inv can be only sent by invitee member" _ -> messageError "x.grp.mem.inv can be only sent by invitee member"
xGrpMemFwd :: GroupInfo -> GroupMember -> MemberInfo -> IntroInvitation -> m () xGrpMemFwd :: GroupInfo -> GroupMember -> MemberInfo -> IntroInvitation -> m ()
xGrpMemFwd gInfo@GroupInfo {membership, chatSettings} m memInfo@(MemberInfo memId memRole memberChatVRange _) introInv@IntroInvitation {groupConnReq, directConnReq} = do xGrpMemFwd gInfo@GroupInfo {membership, chatSettings} m memInfo@(MemberInfo memId memRole memChatVRange _) introInv@IntroInvitation {groupConnReq, directConnReq} = do
checkHostRole m memRole checkHostRole m memRole
members <- withStore' $ \db -> getGroupMembers db user gInfo members <- withStore' $ \db -> getGroupMembers db user gInfo
toMember <- case find (sameMemberId memId) members of toMember <- case find (sameMemberId memId) members of
@ -4946,7 +5001,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- the situation when member does not exist is an error -- 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. -- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that.
-- For now, this branch compensates for the lack of delayed message delivery. -- For now, this branch compensates for the lack of delayed message delivery.
Nothing -> withStore $ \db -> createNewGroupMember db user gInfo memInfo GCPostMember GSMemAnnounced Nothing -> withStore $ \db -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced
Just m' -> pure m' Just m' -> pure m'
withStore' $ \db -> saveMemberInvitation db toMember introInv withStore' $ \db -> saveMemberInvitation db toMember introInv
subMode <- chatReadVar subscriptionMode subMode <- chatReadVar subscriptionMode
@ -4956,11 +5011,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
groupConnIds <- joinAgentConnectionAsync user (chatHasNtfs chatSettings) groupConnReq dm subMode groupConnIds <- joinAgentConnectionAsync user (chatHasNtfs chatSettings) groupConnReq dm subMode
directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user True dcr dm subMode directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user True dcr dm subMode
let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
mcvr = maybe chatInitialVRange fromChatVRange memberChatVRange mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
withStore' $ \db -> createIntroToMemberContact db user m toMember mcvr groupConnIds directConnIds customUserProfileId subMode withStore' $ \db -> createIntroToMemberContact db user m toMember mcvr groupConnIds directConnIds customUserProfileId subMode
xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> MsgMeta -> m () xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> UTCTime -> m ()
xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg msgMeta xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg brokerTs
| membership.memberId == memId = | membership.memberId == memId =
let gInfo' = gInfo {membership = membership {memberRole = memRole}} let gInfo' = gInfo {membership = membership {memberRole = memRole}}
in changeMemberRole gInfo' membership $ RGEUserRole memRole in changeMemberRole gInfo' membership $ RGEUserRole memRole
@ -4974,16 +5029,54 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
| senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions" | senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions"
| otherwise = do | otherwise = do
withStore' $ \db -> updateGroupMemberRole db user member memRole withStore' $ \db -> updateGroupMemberRole db user member memRole
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent) ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent)
groupMsgToView gInfo m ci msgMeta groupMsgToView gInfo ci
toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole} toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole}
checkHostRole :: GroupMember -> GroupMemberRole -> m () checkHostRole :: GroupMember -> GroupMemberRole -> m ()
checkHostRole GroupMember {memberRole, localDisplayName} memRole = checkHostRole GroupMember {memberRole, localDisplayName} memRole =
when (memberRole < GRAdmin || memberRole < memRole) $ throwChatError (CEGroupContactRole localDisplayName) when (memberRole < GRAdmin || memberRole < memRole) $ throwChatError (CEGroupContactRole localDisplayName)
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> MsgMeta -> m () xGrpMemCon :: GroupInfo -> GroupMember -> MemberId -> m ()
xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId msg msgMeta = do xGrpMemCon gInfo sendingMember memId = do
refMember <- withStore $ \db -> getGroupMemberByMemberId db user gInfo memId
case (memberCategory sendingMember, memberCategory refMember) of
(GCInviteeMember, GCInviteeMember) ->
withStore' (\db -> runExceptT $ getIntroduction db refMember sendingMember) >>= \case
Right intro -> inviteeXGrpMemCon intro
Left _ -> withStore' (\db -> runExceptT $ getIntroduction db sendingMember refMember) >>= \case
Right intro -> forwardMemberXGrpMemCon intro
Left _ -> messageWarning "x.grp.mem.con: no introduction"
(GCInviteeMember, _) ->
withStore' (\db -> runExceptT $ getIntroduction db refMember sendingMember) >>= \case
Right intro -> inviteeXGrpMemCon intro
Left _ -> messageWarning "x.grp.mem.con: no introduction"
(_, GCInviteeMember) ->
withStore' (\db -> runExceptT $ getIntroduction db sendingMember refMember) >>= \case
Right intro -> forwardMemberXGrpMemCon intro
Left _ -> messageWarning "x.grp.mem.con: no introductiosupportn"
-- Note: we can allow XGrpMemCon to all member categories if we decide to support broader group forwarding,
-- deduplication (see saveGroupRcvMsg, saveGroupFwdRcvMsg) already supports sending XGrpMemCon
-- to any forwarding member, not only host/inviting member;
-- database would track all members connections then
-- (currently it's done via group_member_intros for introduced connections only)
_ ->
messageWarning "x.grp.mem.con: neither member is invitee"
where
inviteeXGrpMemCon :: GroupMemberIntro -> m ()
inviteeXGrpMemCon GroupMemberIntro {introId, introStatus}
| introStatus == GMIntroReConnected = updateStatus introId GMIntroConnected
| introStatus `elem` [GMIntroToConnected, GMIntroConnected] = pure ()
| otherwise = updateStatus introId GMIntroToConnected
forwardMemberXGrpMemCon :: GroupMemberIntro -> m ()
forwardMemberXGrpMemCon GroupMemberIntro {introId, introStatus}
| introStatus == GMIntroToConnected = updateStatus introId GMIntroConnected
| introStatus `elem` [GMIntroReConnected, GMIntroConnected] = pure ()
| otherwise = updateStatus introId GMIntroReConnected
updateStatus introId status = withStore' $ \db -> updateIntroStatus db introId status
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> UTCTime -> m ()
xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId msg brokerTs = do
members <- withStore' $ \db -> getGroupMembers db user gInfo members <- withStore' $ \db -> getGroupMembers db user gInfo
if membership.memberId == memId if membership.memberId == memId
then checkRole membership $ do then checkRole membership $ do
@ -5009,23 +5102,20 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
messageError "x.grp.mem.del with insufficient member permissions" messageError "x.grp.mem.del with insufficient member permissions"
| otherwise = a | otherwise = a
deleteMemberItem gEvent = do deleteMemberItem gEvent = do
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent) ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent)
groupMsgToView gInfo m ci msgMeta groupMsgToView gInfo ci
sameMemberId :: MemberId -> GroupMember -> Bool xGrpLeave :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> m ()
sameMemberId memId GroupMember {memberId} = memId == memberId xGrpLeave gInfo m msg brokerTs = do
xGrpLeave :: GroupInfo -> GroupMember -> RcvMessage -> MsgMeta -> m ()
xGrpLeave gInfo m msg msgMeta = do
deleteMemberConnection user m deleteMemberConnection user m
-- member record is not deleted to allow creation of "member left" chat item -- member record is not deleted to allow creation of "member left" chat item
withStore' $ \db -> updateGroupMemberStatus db userId m GSMemLeft withStore' $ \db -> updateGroupMemberStatus db userId m GSMemLeft
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEMemberLeft) ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEMemberLeft)
groupMsgToView gInfo m ci msgMeta groupMsgToView gInfo ci
toView $ CRLeftMember user gInfo m {memberStatus = GSMemLeft} toView $ CRLeftMember user gInfo m {memberStatus = GSMemLeft}
xGrpDel :: GroupInfo -> GroupMember -> RcvMessage -> MsgMeta -> m () xGrpDel :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> m ()
xGrpDel gInfo@GroupInfo {membership} m@GroupMember {memberRole} msg msgMeta = do xGrpDel gInfo@GroupInfo {membership} m@GroupMember {memberRole} msg brokerTs = do
when (memberRole /= GROwner) $ throwChatError $ CEGroupUserRole gInfo GROwner when (memberRole /= GROwner) $ throwChatError $ CEGroupUserRole gInfo GROwner
ms <- withStore' $ \db -> do ms <- withStore' $ \db -> do
members <- getGroupMembers db user gInfo members <- getGroupMembers db user gInfo
@ -5033,24 +5123,24 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
pure members pure members
-- member records are not deleted to keep history -- member records are not deleted to keep history
deleteMembersConnections user ms deleteMembersConnections user ms
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted) ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEGroupDeleted)
groupMsgToView gInfo m ci msgMeta groupMsgToView gInfo ci
toView $ CRGroupDeleted user gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m toView $ CRGroupDeleted user gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m
xGrpInfo :: GroupInfo -> GroupMember -> GroupProfile -> RcvMessage -> MsgMeta -> m () xGrpInfo :: GroupInfo -> GroupMember -> GroupProfile -> RcvMessage -> UTCTime -> m ()
xGrpInfo g@GroupInfo {groupProfile = p} m@GroupMember {memberRole} p' msg msgMeta xGrpInfo g@GroupInfo {groupProfile = p} m@GroupMember {memberRole} p' msg brokerTs
| memberRole < GROwner = messageError "x.grp.info with insufficient member permissions" | memberRole < GROwner = messageError "x.grp.info with insufficient member permissions"
| otherwise = unless (p == p') $ do | otherwise = unless (p == p') $ do
g' <- withStore $ \db -> updateGroupProfile db user g p' g' <- withStore $ \db -> updateGroupProfile db user g p'
toView $ CRGroupUpdated user g g' (Just m) toView $ CRGroupUpdated user g g' (Just m)
let cd = CDGroupRcv g' m let cd = CDGroupRcv g' m
unless (sameGroupProfileInfo p p') $ do unless (sameGroupProfileInfo p p') $ do
ci <- saveRcvChatItem user cd msg msgMeta (CIRcvGroupEvent $ RGEGroupUpdated p') ci <- saveRcvChatItem user cd msg brokerTs (CIRcvGroupEvent $ RGEGroupUpdated p')
groupMsgToView g' m ci msgMeta groupMsgToView g' ci
createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' createGroupFeatureChangedItems user cd CIRcvGroupFeature g g'
xGrpDirectInv :: GroupInfo -> GroupMember -> Connection -> ConnReqInvitation -> Maybe MsgContent -> RcvMessage -> MsgMeta -> m () xGrpDirectInv :: GroupInfo -> GroupMember -> Connection -> ConnReqInvitation -> Maybe MsgContent -> RcvMessage -> UTCTime -> m ()
xGrpDirectInv g m mConn connReq mContent_ msg msgMeta = do xGrpDirectInv g m mConn connReq mContent_ msg brokerTs = do
unless (groupFeatureAllowed SGFDirectMessages g) $ messageError "x.grp.direct.inv: direct messages not allowed" unless (groupFeatureAllowed SGFDirectMessages g) $ messageError "x.grp.direct.inv: direct messages not allowed"
let GroupMember {memberContactId} = m let GroupMember {memberContactId} = m
subMode <- chatReadVar subscriptionMode subMode <- chatReadVar subscriptionMode
@ -5086,11 +5176,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
dm <- directMessage $ XInfo p dm <- directMessage $ XInfo p
joinAgentConnectionAsync user True connReq dm subMode joinAgentConnectionAsync user True connReq dm subMode
createItems mCt' m' = do createItems mCt' m' = do
checkIntegrityCreateItem (CDGroupRcv g m') msgMeta
createInternalChatItem user (CDGroupRcv g m') (CIRcvGroupEvent RGEMemberCreatedContact) Nothing createInternalChatItem user (CDGroupRcv g m') (CIRcvGroupEvent RGEMemberCreatedContact) Nothing
toView $ CRNewMemberContactReceivedInv user mCt' g m' toView $ CRNewMemberContactReceivedInv user mCt' g m'
forM_ mContent_ $ \mc -> do forM_ mContent_ $ \mc -> do
ci <- saveRcvChatItem user (CDDirectRcv mCt') msg msgMeta (CIRcvMsgContent mc) ci <- saveRcvChatItem user (CDDirectRcv mCt') msg brokerTs (CIRcvMsgContent mc)
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat mCt') ci) toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat mCt') ci)
securityCodeChanged :: Contact -> m () securityCodeChanged :: Contact -> m ()
@ -5098,6 +5187,33 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
toView $ CRContactVerificationReset user ct toView $ CRContactVerificationReset user ct
createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
xGrpMsgForward :: GroupInfo -> GroupMember -> MemberId -> ChatMessage 'Json -> UTCTime -> m ()
xGrpMsgForward gInfo@GroupInfo {groupId} m memberId msg msgTs = do
when (m.memberRole < GRAdmin) $ throwChatError (CEGroupContactRole m.localDisplayName)
author <- withStore $ \db -> getGroupMemberByMemberId db user gInfo memberId
processForwardedMsg author msg
where
-- Note: forwarded group events (see forwardedGroupMsg) should include msgId to be deduplicated
processForwardedMsg :: GroupMember -> ChatMessage 'Json -> m ()
processForwardedMsg author chatMsg = do
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
XMsgFileDescr sharedMsgId fileDescr -> memberCanSend author $ groupMessageFileDescription gInfo author sharedMsgId fileDescr
XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend author $ groupMessageUpdate gInfo author sharedMsgId mContent 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
XInfo p -> xInfoMember gInfo author p
XGrpMemNew memInfo -> xGrpMemNew gInfo author memInfo rcvMsg msgTs
XGrpMemRole memId memRole -> xGrpMemRole gInfo author memId memRole rcvMsg msgTs
XGrpMemDel memId -> xGrpMemDel gInfo author memId rcvMsg msgTs
XGrpLeave -> xGrpLeave gInfo author rcvMsg msgTs
XGrpDel -> xGrpDel gInfo author rcvMsg msgTs
XGrpInfo p' -> xGrpInfo gInfo author p' rcvMsg msgTs
_ -> messageError $ "x.grp.msg.forward: unsupported forwarded event " <> T.pack (show $ toCMEventTag event)
directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m () directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
@ -5146,6 +5262,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
toView $ CRChatItemStatusUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) chatItem) toView $ CRChatItemStatusUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) chatItem)
_ -> pure () _ -> pure ()
metaBrokerTs :: MsgMeta -> UTCTime
metaBrokerTs MsgMeta {broker = (_, brokerTs)} = brokerTs
sameMemberId :: MemberId -> GroupMember -> Bool
sameMemberId memId GroupMember {memberId} = memId == memberId
updatePeerChatVRange :: ChatMonad m => Connection -> VersionRange -> m Connection updatePeerChatVRange :: ChatMonad m => Connection -> VersionRange -> m Connection
updatePeerChatVRange conn@Connection {connId, peerChatVRange} msgChatVRange = do updatePeerChatVRange conn@Connection {connId, peerChatVRange} msgChatVRange = do
let jMsgChatVRange = JVersionRange msgChatVRange let jMsgChatVRange = JVersionRange msgChatVRange
@ -5155,6 +5277,18 @@ updatePeerChatVRange conn@Connection {connId, peerChatVRange} msgChatVRange = do
pure conn {peerChatVRange = jMsgChatVRange} pure conn {peerChatVRange = jMsgChatVRange}
else pure conn else pure conn
updateMemberChatVRange :: ChatMonad m => GroupMember -> Connection -> VersionRange -> m (GroupMember, Connection)
updateMemberChatVRange mem@GroupMember {groupMemberId} conn@Connection {connId, peerChatVRange} msgChatVRange = do
let jMsgChatVRange = JVersionRange msgChatVRange
if jMsgChatVRange /= peerChatVRange
then do
withStore' $ \db -> do
setPeerChatVRange db connId msgChatVRange
setMemberChatVRange db groupMemberId msgChatVRange
let conn' = conn {peerChatVRange = jMsgChatVRange}
pure (mem {memberChatVRange = jMsgChatVRange, activeConn = Just conn'}, conn')
else pure (mem, conn)
parseFileDescription :: (ChatMonad m, FilePartyI p) => Text -> m (ValidFileDescription p) parseFileDescription :: (ChatMonad m, FilePartyI p) => Text -> m (ValidFileDescription p)
parseFileDescription = parseFileDescription =
liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8) liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8)
@ -5400,18 +5534,36 @@ sendGroupMessage' user members chatMsgEvent groupId introId_ postDeliver = do
where where
messageMember :: GroupMember -> SndMessage -> m (Maybe GroupMember) messageMember :: GroupMember -> SndMessage -> m (Maybe GroupMember)
messageMember m@GroupMember {groupMemberId} SndMessage {msgId, msgBody} = case memberConn m of messageMember m@GroupMember {groupMemberId} SndMessage {msgId, msgBody} = case memberConn m of
Nothing -> do Nothing -> pendingOrForwarded
withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_
pure $ Just m
Just conn@Connection {connStatus} Just conn@Connection {connStatus}
| connDisabled conn || connStatus == ConnDeleted -> pure Nothing | connDisabled conn || connStatus == ConnDeleted -> pure Nothing
| connStatus == ConnSndReady || connStatus == ConnReady -> do | connStatus == ConnSndReady || connStatus == ConnReady -> do
let tag = toCMEventTag chatMsgEvent let tag = toCMEventTag chatMsgEvent
deliverMessage conn tag msgBody msgId >> postDeliver deliverMessage conn tag msgBody msgId >> postDeliver
pure $ Just m pure $ Just m
| otherwise -> do | otherwise -> pendingOrForwarded
withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_ where
pure $ Just m pendingOrForwarded
| forwardSupported && isForwardedGroupMsg chatMsgEvent = pure Nothing
| isXGrpMsgForward chatMsgEvent = pure Nothing
| otherwise = do
withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_
pure $ Just m
forwardSupported = do
let mcvr = memberChatVRange' m
isCompatibleRange mcvr groupForwardVRange && invitingMemberSupportsForward
invitingMemberSupportsForward = case m.invitedByGroupMemberId of
Just invMemberId ->
-- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember
case find (\m' -> groupMemberId' m' == invMemberId) members of
Just invitingMember -> do
let mcvr = memberChatVRange' invitingMember
isCompatibleRange mcvr groupForwardVRange
Nothing -> False
Nothing -> False
isXGrpMsgForward ev = case ev of
XGrpMsgForward {} -> True
_ -> False
sendPendingGroupMessages :: ChatMonad m => User -> GroupMember -> Connection -> m () sendPendingGroupMessages :: ChatMonad m => User -> GroupMember -> Connection -> m ()
sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn = do sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn = do
@ -5429,18 +5581,49 @@ sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn
_ -> throwChatError $ CEGroupMemberIntroNotFound localDisplayName _ -> throwChatError $ CEGroupMemberIntroNotFound localDisplayName
_ -> pure () _ -> pure ()
saveRcvMSG :: ChatMonad m => Connection -> ConnOrGroupId -> MsgMeta -> MsgBody -> CommandId -> m (Connection, RcvMessage) saveDirectRcvMSG :: ChatMonad m => Connection -> MsgMeta -> CommandId -> MsgBody -> m (Connection, RcvMessage)
saveRcvMSG conn@Connection {connId} connOrGroupId agentMsgMeta msgBody agentAckCmdId = do saveDirectRcvMSG conn@Connection {connId} agentMsgMeta agentAckCmdId msgBody = do
ACMsg _ ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} <- parseAChatMessage conn agentMsgMeta msgBody ACMsg _ ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} <- parseAChatMessage conn agentMsgMeta msgBody
conn' <- updatePeerChatVRange conn chatVRange conn' <- updatePeerChatVRange conn chatVRange
let agentMsgId = fst $ recipient agentMsgMeta let agentMsgId = fst $ recipient agentMsgMeta
newMsg = NewMessage {chatMsgEvent, msgBody} newMsg = NewMessage {chatMsgEvent, msgBody}
rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
msg <- withStoreCtx' msg <- withStore $ \db -> createNewMessageAndRcvMsgDelivery db (ConnectionId connId) newMsg sharedMsgId_ rcvMsgDelivery Nothing
(Just $ "createNewMessageAndRcvMsgDelivery, rcvMsgDelivery: " <> show rcvMsgDelivery <> ", sharedMsgId_: " <> show sharedMsgId_ <> ", msgDeliveryStatus: MDSRcvAgent")
$ \db -> createNewMessageAndRcvMsgDelivery db connOrGroupId newMsg sharedMsgId_ rcvMsgDelivery
pure (conn', msg) pure (conn', msg)
saveGroupRcvMsg :: (MsgEncodingI e, ChatMonad m) => User -> GroupId -> GroupMember -> Connection -> MsgMeta -> CommandId -> MsgBody -> ChatMessage e -> m (GroupMember, Connection, RcvMessage)
saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta agentAckCmdId msgBody ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} = do
(am', conn') <- updateMemberChatVRange authorMember conn chatVRange
let agentMsgId = fst $ recipient agentMsgMeta
newMsg = NewMessage {chatMsgEvent, msgBody}
rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
amId = Just am'.groupMemberId
msg <- withStore (\db -> createNewMessageAndRcvMsgDelivery db (GroupId groupId) newMsg sharedMsgId_ rcvMsgDelivery amId)
`catchChatError` \e -> case e of
ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do
fm <- withStore $ \db -> getGroupMember db user groupId forwardedByGroupMemberId
forM_ (memberConn fm) $ \fmConn ->
void $ sendDirectMessage fmConn (XGrpMemCon am'.memberId) (GroupId groupId)
throwError e
_ -> throwError e
pure (am', conn', msg)
saveGroupFwdRcvMsg :: (MsgEncodingI e, ChatMonad m) => User -> GroupId -> GroupMember -> GroupMember -> MsgBody -> ChatMessage e -> m RcvMessage
saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember msgBody ChatMessage {msgId = sharedMsgId_, chatMsgEvent} = do
let newMsg = NewMessage {chatMsgEvent, msgBody}
fwdMemberId = Just $ groupMemberId' forwardingMember
refAuthorId = Just $ groupMemberId' refAuthorMember
withStore (\db -> createNewRcvMessage db (GroupId groupId) newMsg sharedMsgId_ refAuthorId fwdMemberId)
`catchChatError` \e -> case e of
ChatErrorStore (SEDuplicateGroupMessage _ _ (Just authorGroupMemberId) Nothing) -> do
am <- withStore $ \db -> getGroupMember db user groupId authorGroupMemberId
if sameMemberId refAuthorMember.memberId am
then forM_ (memberConn forwardingMember) $ \fmConn ->
void $ sendDirectMessage fmConn (XGrpMemCon am.memberId) (GroupId groupId)
else toView $ CRMessageError user "error" "saveGroupFwdRcvMsg: referenced author member id doesn't match message member id"
throwError e
_ -> throwError e
saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> m (ChatItem c 'MDSnd) saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> m (ChatItem c 'MDSnd)
saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing Nothing False saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing Nothing False
@ -5452,27 +5635,27 @@ saveSndChatItem' user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem
ciId <- createNewSndChatItem db user cd msg content quotedItem itemTimed live createdAt ciId <- createNewSndChatItem db user cd msg content quotedItem itemTimed live createdAt
forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
pure ciId pure ciId
liftIO $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) itemTimed live createdAt createdAt liftIO $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) itemTimed live createdAt Nothing createdAt
saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> m (ChatItem c 'MDRcv) saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> CIContent 'MDRcv -> m (ChatItem c 'MDRcv)
saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} msgMeta content = saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} brokerTs content =
saveRcvChatItem' user cd msg sharedMsgId_ msgMeta content Nothing Nothing False saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False
saveRcvChatItem' :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDRcv) saveRcvChatItem' :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDRcv)
saveRcvChatItem' user cd msg sharedMsgId_ MsgMeta {broker = (_, brokerTs)} content ciFile itemTimed live = do saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content ciFile itemTimed live = do
createdAt <- liftIO getCurrentTime createdAt <- liftIO getCurrentTime
(ciId, quotedItem) <- withStore' $ \db -> do (ciId, quotedItem) <- withStore' $ \db -> do
when (ciRequiresAttention content) $ updateChatTs db user cd createdAt when (ciRequiresAttention content) $ updateChatTs db user cd createdAt
(ciId, quotedItem) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt (ciId, quotedItem) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt
forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
pure (ciId, quotedItem) pure (ciId, quotedItem)
liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemTimed live brokerTs createdAt liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemTimed live brokerTs msg.forwardedByGroupMemberId createdAt
mkChatItem :: forall c d. MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> UTCTime -> IO (ChatItem c d) mkChatItem :: forall c d. MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> IO (ChatItem c d)
mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs currentTs = do mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs forwardedByGroupMemberId currentTs = do
let itemText = ciContentToText content let itemText = ciContentToText content
itemStatus = ciCreateStatus content itemStatus = ciCreateStatus content
meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) currentTs itemTs currentTs currentTs meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) currentTs itemTs forwardedByGroupMemberId currentTs currentTs
pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file} pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file}
deleteDirectCI :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> Bool -> Bool -> m ChatResponse deleteDirectCI :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> Bool -> Bool -> m ChatResponse
@ -5635,7 +5818,7 @@ createInternalChatItem user cd content itemTs_ = do
ciId <- withStore' $ \db -> do ciId <- withStore' $ \db -> do
when (ciRequiresAttention content) $ updateChatTs db user cd createdAt when (ciRequiresAttention content) $ updateChatTs db user cd createdAt
createNewChatItemNoMsg db user cd content itemTs createdAt createNewChatItemNoMsg db user cd content itemTs createdAt
ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing Nothing False itemTs createdAt ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing Nothing False itemTs Nothing createdAt
toView $ CRNewChatItem user (AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci) toView $ CRNewChatItem user (AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci)
getCreateActiveUser :: SQLiteStore -> Bool -> IO User getCreateActiveUser :: SQLiteStore -> Bool -> IO User

View File

@ -134,7 +134,8 @@ data ChatConfig = ChatConfig
cleanupManagerInterval :: NominalDiffTime, cleanupManagerInterval :: NominalDiffTime,
cleanupManagerStepDelay :: Int64, cleanupManagerStepDelay :: Int64,
ciExpirationInterval :: Int64, -- microseconds ciExpirationInterval :: Int64, -- microseconds
coreApi :: Bool coreApi :: Bool,
highlyAvailable :: Bool
} }
data DefaultAgentServers = DefaultAgentServers data DefaultAgentServers = DefaultAgentServers

View File

@ -163,7 +163,7 @@ isMention ChatItem {chatDir, quotedItem} = case chatDir of
CIQDirectSnd -> True CIQDirectSnd -> True
CIQGroupSnd -> True CIQGroupSnd -> True
_ -> False _ -> False
data CIDirection (c :: ChatType) (d :: MsgDirection) where data CIDirection (c :: ChatType) (d :: MsgDirection) where
CIDirectSnd :: CIDirection 'CTDirect 'MDSnd CIDirectSnd :: CIDirection 'CTDirect 'MDSnd
CIDirectRcv :: CIDirection 'CTDirect 'MDRcv CIDirectRcv :: CIDirection 'CTDirect 'MDRcv
@ -318,17 +318,18 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
itemTimed :: Maybe CITimed, itemTimed :: Maybe CITimed,
itemLive :: Maybe Bool, itemLive :: Maybe Bool,
editable :: Bool, editable :: Bool,
forwardedByGroupMemberId :: Maybe GroupMemberId,
createdAt :: UTCTime, createdAt :: UTCTime,
updatedAt :: UTCTime updatedAt :: UTCTime
} }
deriving (Show) deriving (Show)
mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> CIMeta c d mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs createdAt updatedAt = mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs forwardedByGroupMemberId createdAt updatedAt =
let editable = case itemContent of let editable = case itemContent of
CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted
_ -> False _ -> False
in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, createdAt, updatedAt} in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, forwardedByGroupMemberId, createdAt, updatedAt}
data CITimed = CITimed data CITimed = CITimed
{ ttl :: Int, -- seconds { ttl :: Int, -- seconds
@ -782,7 +783,9 @@ data RcvMessage = RcvMessage
{ msgId :: MessageId, { msgId :: MessageId,
chatMsgEvent :: AChatMsgEvent, chatMsgEvent :: AChatMsgEvent,
sharedMsgId_ :: Maybe SharedMsgId, sharedMsgId_ :: Maybe SharedMsgId,
msgBody :: MsgBody msgBody :: MsgBody,
authorGroupMemberId :: Maybe GroupMemberId,
forwardedByGroupMemberId :: Maybe GroupMemberId
} }
data PendingGroupMessage = PendingGroupMessage data PendingGroupMessage = PendingGroupMessage

View File

@ -0,0 +1,53 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20231113_group_forward where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20231113_group_forward :: Query
m20231113_group_forward =
[sql|
ALTER TABLE group_member_intros ADD COLUMN intro_chat_protocol_version INTEGER NOT NULL DEFAULT 3;
CREATE INDEX idx_group_member_intros_re_group_member_id ON group_member_intros(re_group_member_id);
ALTER TABLE group_members ADD COLUMN invited_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL;
ALTER TABLE group_members ADD COLUMN peer_chat_min_version INTEGER NOT NULL DEFAULT 1;
ALTER TABLE group_members ADD COLUMN peer_chat_max_version INTEGER NOT NULL DEFAULT 1;
CREATE INDEX idx_group_members_invited_by_group_member_id ON group_members(invited_by_group_member_id);
UPDATE group_members
SET (peer_chat_min_version, peer_chat_max_version) = (c.peer_chat_min_version, c.peer_chat_max_version)
FROM connections c
WHERE c.group_member_id = group_members.group_member_id;
ALTER TABLE messages ADD COLUMN author_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL;
ALTER TABLE messages ADD COLUMN forwarded_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL;
CREATE INDEX idx_messages_author_group_member_id ON messages(author_group_member_id);
CREATE INDEX idx_messages_forwarded_by_group_member_id ON messages(forwarded_by_group_member_id);
CREATE INDEX idx_messages_group_id_shared_msg_id ON messages(group_id, shared_msg_id);
ALTER TABLE chat_items ADD COLUMN forwarded_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL;
CREATE INDEX idx_chat_items_forwarded_by_group_member_id ON chat_items(forwarded_by_group_member_id);
|]
down_m20231113_group_forward :: Query
down_m20231113_group_forward =
[sql|
DROP INDEX idx_chat_items_forwarded_by_group_member_id;
ALTER TABLE chat_items DROP COLUMN forwarded_by_group_member_id;
DROP INDEX idx_messages_group_id_shared_msg_id;
DROP INDEX idx_messages_forwarded_by_group_member_id;
DROP INDEX idx_messages_author_group_member_id;
ALTER TABLE messages DROP COLUMN forwarded_by_group_member_id;
ALTER TABLE messages DROP COLUMN author_group_member_id;
DROP INDEX idx_group_members_invited_by_group_member_id;
ALTER TABLE group_members DROP COLUMN peer_chat_max_version;
ALTER TABLE group_members DROP COLUMN peer_chat_min_version;
ALTER TABLE group_members DROP COLUMN invited_by_group_member_id;
DROP INDEX idx_group_member_intros_re_group_member_id;
ALTER TABLE group_member_intros DROP COLUMN intro_chat_protocol_version;
|]

View File

@ -147,6 +147,9 @@ CREATE TABLE group_members(
member_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL, member_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
show_messages INTEGER NOT NULL DEFAULT 1, show_messages INTEGER NOT NULL DEFAULT 1,
xgrplinkmem_received INTEGER NOT NULL DEFAULT 0, xgrplinkmem_received INTEGER NOT NULL DEFAULT 0,
invited_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
peer_chat_min_version INTEGER NOT NULL DEFAULT 1,
peer_chat_max_version INTEGER NOT NULL DEFAULT 1,
FOREIGN KEY(user_id, local_display_name) FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE ON DELETE CASCADE
@ -161,7 +164,8 @@ CREATE TABLE group_member_intros(
direct_queue_info BLOB, direct_queue_info BLOB,
intro_status TEXT NOT NULL, intro_status TEXT NOT NULL,
created_at TEXT CHECK(created_at NOT NULL), created_at TEXT CHECK(created_at NOT NULL),
updated_at TEXT CHECK(updated_at NOT NULL), -- see GroupMemberIntroStatus updated_at TEXT CHECK(updated_at NOT NULL),
intro_chat_protocol_version INTEGER NOT NULL DEFAULT 3, -- see GroupMemberIntroStatus
UNIQUE(re_group_member_id, to_group_member_id) UNIQUE(re_group_member_id, to_group_member_id)
); );
CREATE TABLE files( CREATE TABLE files(
@ -322,7 +326,9 @@ CREATE TABLE messages(
connection_id INTEGER DEFAULT NULL REFERENCES connections ON DELETE CASCADE, connection_id INTEGER DEFAULT NULL REFERENCES connections ON DELETE CASCADE,
group_id INTEGER DEFAULT NULL REFERENCES groups ON DELETE CASCADE, group_id INTEGER DEFAULT NULL REFERENCES groups ON DELETE CASCADE,
shared_msg_id BLOB, shared_msg_id BLOB,
shared_msg_id_user INTEGER shared_msg_id_user INTEGER,
author_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
forwarded_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL
); );
CREATE TABLE msg_deliveries( CREATE TABLE msg_deliveries(
msg_delivery_id INTEGER PRIMARY KEY, msg_delivery_id INTEGER PRIMARY KEY,
@ -372,7 +378,8 @@ CREATE TABLE chat_items(
timed_delete_at TEXT, timed_delete_at TEXT,
item_live INTEGER, item_live INTEGER,
item_deleted_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL, item_deleted_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
item_deleted_ts TEXT item_deleted_ts TEXT,
forwarded_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL
); );
CREATE TABLE chat_item_messages( CREATE TABLE chat_item_messages(
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE, chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
@ -782,3 +789,22 @@ CREATE INDEX idx_contact_profiles_contact_link ON contact_profiles(
user_id, user_id,
contact_link contact_link
); );
CREATE INDEX idx_group_member_intros_re_group_member_id ON group_member_intros(
re_group_member_id
);
CREATE INDEX idx_group_members_invited_by_group_member_id ON group_members(
invited_by_group_member_id
);
CREATE INDEX idx_messages_author_group_member_id ON messages(
author_group_member_id
);
CREATE INDEX idx_messages_forwarded_by_group_member_id ON messages(
forwarded_by_group_member_id
);
CREATE INDEX idx_messages_group_id_shared_msg_id ON messages(
group_id,
shared_msg_id
);
CREATE INDEX idx_chat_items_forwarded_by_group_member_id ON chat_items(
forwarded_by_group_member_id
);

View File

@ -178,7 +178,8 @@ mobileChatOpts dbFilePrefix dbKey =
logServerHosts = True, logServerHosts = True,
logAgent = Nothing, logAgent = Nothing,
logFile = Nothing, logFile = Nothing,
tbqSize = 1024 tbqSize = 1024,
highlyAvailable = False
}, },
chatCmd = "", chatCmd = "",
chatCmdDelay = 3, chatCmdDelay = 3,

View File

@ -54,7 +54,8 @@ data CoreChatOpts = CoreChatOpts
logServerHosts :: Bool, logServerHosts :: Bool,
logAgent :: Maybe LogLevel, logAgent :: Maybe LogLevel,
logFile :: Maybe FilePath, logFile :: Maybe FilePath,
tbqSize :: Natural tbqSize :: Natural,
highlyAvailable :: Bool
} }
agentLogLevel :: ChatLogLevel -> LogLevel agentLogLevel :: ChatLogLevel -> LogLevel
@ -172,6 +173,11 @@ coreChatOptsP appDir defaultDbFileName = do
<> value 1024 <> value 1024
<> showDefault <> showDefault
) )
highlyAvailable <-
switch
( long "ha"
<> help "Run as a highly available client (this may increase traffic in groups)"
)
pure pure
CoreChatOpts CoreChatOpts
{ dbFilePrefix, { dbFilePrefix,
@ -184,7 +190,8 @@ coreChatOptsP appDir defaultDbFileName = do
logServerHosts = logServerHosts || logLevel <= CLLInfo, logServerHosts = logServerHosts || logLevel <= CLLInfo,
logAgent = if logAgent || logLevel == CLLDebug then Just $ agentLogLevel logLevel else Nothing, logAgent = if logAgent || logLevel == CLLDebug then Just $ agentLogLevel logLevel else Nothing,
logFile, logFile,
tbqSize tbqSize,
highlyAvailable
} }
where where
useTcpTimeout p t = 1000000 * if t > 0 then t else maybe 5 (const 10) p useTcpTimeout p t = 1000000 * if t > 0 then t else maybe 5 (const 10) p

View File

@ -1,6 +1,7 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-} {-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
@ -19,7 +20,7 @@ module Simplex.Chat.Protocol where
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Monad ((<=<)) import Control.Monad ((<=<))
import Data.Aeson (FromJSON, ToJSON, (.:), (.:?), (.=)) import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=))
import qualified Data.Aeson as J import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE import qualified Data.Aeson.Encoding as JE
import qualified Data.Aeson.KeyMap as JM import qualified Data.Aeson.KeyMap as JM
@ -51,7 +52,7 @@ import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
import Simplex.Messaging.Version hiding (version) import Simplex.Messaging.Version hiding (version)
currentChatVersion :: Version currentChatVersion :: Version
currentChatVersion = 3 currentChatVersion = 4
supportedChatVRange :: VersionRange supportedChatVRange :: VersionRange
supportedChatVRange = mkVersionRange 1 currentChatVersion supportedChatVRange = mkVersionRange 1 currentChatVersion
@ -68,6 +69,10 @@ xGrpDirectInvVRange = mkVersionRange 2 currentChatVersion
groupLinkNoContactVRange :: VersionRange groupLinkNoContactVRange :: VersionRange
groupLinkNoContactVRange = mkVersionRange 3 currentChatVersion groupLinkNoContactVRange = mkVersionRange 3 currentChatVersion
-- version range that supports group forwarding
groupForwardVRange :: VersionRange
groupForwardVRange = mkVersionRange 4 currentChatVersion
data ConnectionEntity data ConnectionEntity
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact} = RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
| RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember} | RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
@ -208,7 +213,6 @@ data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMess
data ChatMsgEvent (e :: MsgEncoding) where data ChatMsgEvent (e :: MsgEncoding) where
XMsgNew :: MsgContainer -> ChatMsgEvent 'Json XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
XMsgFileDescr :: {msgId :: SharedMsgId, fileDescr :: FileDescr} -> ChatMsgEvent 'Json XMsgFileDescr :: {msgId :: SharedMsgId, fileDescr :: FileDescr} -> ChatMsgEvent 'Json
XMsgFileCancel :: SharedMsgId -> ChatMsgEvent 'Json
XMsgUpdate :: {msgId :: SharedMsgId, content :: MsgContent, ttl :: Maybe Int, live :: Maybe Bool} -> ChatMsgEvent 'Json XMsgUpdate :: {msgId :: SharedMsgId, content :: MsgContent, ttl :: Maybe Int, live :: Maybe Bool} -> ChatMsgEvent 'Json
XMsgDel :: SharedMsgId -> Maybe MemberId -> ChatMsgEvent 'Json XMsgDel :: SharedMsgId -> Maybe MemberId -> ChatMsgEvent 'Json
XMsgDeleted :: ChatMsgEvent 'Json XMsgDeleted :: ChatMsgEvent 'Json
@ -230,13 +234,14 @@ data ChatMsgEvent (e :: MsgEncoding) where
XGrpMemFwd :: MemberInfo -> IntroInvitation -> ChatMsgEvent 'Json XGrpMemFwd :: MemberInfo -> IntroInvitation -> ChatMsgEvent 'Json
XGrpMemInfo :: MemberId -> Profile -> ChatMsgEvent 'Json XGrpMemInfo :: MemberId -> Profile -> ChatMsgEvent 'Json
XGrpMemRole :: MemberId -> GroupMemberRole -> ChatMsgEvent 'Json XGrpMemRole :: MemberId -> GroupMemberRole -> ChatMsgEvent 'Json
XGrpMemCon :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented XGrpMemCon :: MemberId -> ChatMsgEvent 'Json
XGrpMemConAll :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented XGrpMemConAll :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented
XGrpMemDel :: MemberId -> ChatMsgEvent 'Json XGrpMemDel :: MemberId -> ChatMsgEvent 'Json
XGrpLeave :: ChatMsgEvent 'Json XGrpLeave :: ChatMsgEvent 'Json
XGrpDel :: ChatMsgEvent 'Json XGrpDel :: ChatMsgEvent 'Json
XGrpInfo :: GroupProfile -> ChatMsgEvent 'Json XGrpInfo :: GroupProfile -> ChatMsgEvent 'Json
XGrpDirectInv :: ConnReqInvitation -> Maybe MsgContent -> ChatMsgEvent 'Json XGrpDirectInv :: ConnReqInvitation -> Maybe MsgContent -> ChatMsgEvent 'Json
XGrpMsgForward :: MemberId -> ChatMessage 'Json -> UTCTime -> ChatMsgEvent 'Json
XInfoProbe :: Probe -> ChatMsgEvent 'Json XInfoProbe :: Probe -> ChatMsgEvent 'Json
XInfoProbeCheck :: ProbeHash -> ChatMsgEvent 'Json XInfoProbeCheck :: ProbeHash -> ChatMsgEvent 'Json
XInfoProbeOk :: Probe -> ChatMsgEvent 'Json XInfoProbeOk :: Probe -> ChatMsgEvent 'Json
@ -257,6 +262,30 @@ data AChatMsgEvent = forall e. MsgEncodingI e => ACME (SMsgEncoding e) (ChatMsgE
deriving instance Show AChatMsgEvent deriving instance Show AChatMsgEvent
isForwardedGroupMsg :: ChatMsgEvent e -> Bool
isForwardedGroupMsg ev = case ev of
XMsgNew mc -> case mcExtMsgContent mc of
ExtMsgContent {file = Just FileInvitation {fileInline = Just _}} -> False
_ -> True
XMsgFileDescr _ _ -> True
XMsgUpdate {} -> True
XMsgDel _ _ -> True
XMsgReact {} -> True
XFileCancel _ -> True
XInfo _ -> True
XGrpMemNew _ -> True
XGrpMemRole {} -> True
XGrpMemDel _ -> True -- TODO there should be a special logic when deleting host member (e.g., host forwards it before deleting connections)
XGrpLeave -> True
XGrpDel -> True -- TODO there should be a special logic - host should forward before deleting connections
XGrpInfo _ -> True
_ -> False
forwardedGroupMsg :: forall e. MsgEncodingI e => ChatMessage e -> Maybe (ChatMessage 'Json)
forwardedGroupMsg msg@ChatMessage {chatMsgEvent} = case encoding @e of
SJson | isForwardedGroupMsg chatMsgEvent -> Just msg
_ -> Nothing
data MsgReaction = MREmoji {emoji :: MREmojiChar} | MRUnknown {tag :: Text, json :: J.Object} data MsgReaction = MREmoji {emoji :: MREmojiChar} | MRUnknown {tag :: Text, json :: J.Object}
deriving (Eq, Show) deriving (Eq, Show)
@ -536,7 +565,6 @@ data ACMEventTag = forall e. MsgEncodingI e => ACMEventTag (SMsgEncoding e) (CME
data CMEventTag (e :: MsgEncoding) where data CMEventTag (e :: MsgEncoding) where
XMsgNew_ :: CMEventTag 'Json XMsgNew_ :: CMEventTag 'Json
XMsgFileDescr_ :: CMEventTag 'Json XMsgFileDescr_ :: CMEventTag 'Json
XMsgFileCancel_ :: CMEventTag 'Json
XMsgUpdate_ :: CMEventTag 'Json XMsgUpdate_ :: CMEventTag 'Json
XMsgDel_ :: CMEventTag 'Json XMsgDel_ :: CMEventTag 'Json
XMsgDeleted_ :: CMEventTag 'Json XMsgDeleted_ :: CMEventTag 'Json
@ -565,6 +593,7 @@ data CMEventTag (e :: MsgEncoding) where
XGrpDel_ :: CMEventTag 'Json XGrpDel_ :: CMEventTag 'Json
XGrpInfo_ :: CMEventTag 'Json XGrpInfo_ :: CMEventTag 'Json
XGrpDirectInv_ :: CMEventTag 'Json XGrpDirectInv_ :: CMEventTag 'Json
XGrpMsgForward_ :: CMEventTag 'Json
XInfoProbe_ :: CMEventTag 'Json XInfoProbe_ :: CMEventTag 'Json
XInfoProbeCheck_ :: CMEventTag 'Json XInfoProbeCheck_ :: CMEventTag 'Json
XInfoProbeOk_ :: CMEventTag 'Json XInfoProbeOk_ :: CMEventTag 'Json
@ -585,7 +614,6 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
strEncode = \case strEncode = \case
XMsgNew_ -> "x.msg.new" XMsgNew_ -> "x.msg.new"
XMsgFileDescr_ -> "x.msg.file.descr" XMsgFileDescr_ -> "x.msg.file.descr"
XMsgFileCancel_ -> "x.msg.file.cancel"
XMsgUpdate_ -> "x.msg.update" XMsgUpdate_ -> "x.msg.update"
XMsgDel_ -> "x.msg.del" XMsgDel_ -> "x.msg.del"
XMsgDeleted_ -> "x.msg.deleted" XMsgDeleted_ -> "x.msg.deleted"
@ -614,6 +642,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
XGrpDel_ -> "x.grp.del" XGrpDel_ -> "x.grp.del"
XGrpInfo_ -> "x.grp.info" XGrpInfo_ -> "x.grp.info"
XGrpDirectInv_ -> "x.grp.direct.inv" XGrpDirectInv_ -> "x.grp.direct.inv"
XGrpMsgForward_ -> "x.grp.msg.forward"
XInfoProbe_ -> "x.info.probe" XInfoProbe_ -> "x.info.probe"
XInfoProbeCheck_ -> "x.info.probe.check" XInfoProbeCheck_ -> "x.info.probe.check"
XInfoProbeOk_ -> "x.info.probe.ok" XInfoProbeOk_ -> "x.info.probe.ok"
@ -635,7 +664,6 @@ instance StrEncoding ACMEventTag where
('x', t) -> pure . ACMEventTag SJson $ case t of ('x', t) -> pure . ACMEventTag SJson $ case t of
"x.msg.new" -> XMsgNew_ "x.msg.new" -> XMsgNew_
"x.msg.file.descr" -> XMsgFileDescr_ "x.msg.file.descr" -> XMsgFileDescr_
"x.msg.file.cancel" -> XMsgFileCancel_
"x.msg.update" -> XMsgUpdate_ "x.msg.update" -> XMsgUpdate_
"x.msg.del" -> XMsgDel_ "x.msg.del" -> XMsgDel_
"x.msg.deleted" -> XMsgDeleted_ "x.msg.deleted" -> XMsgDeleted_
@ -664,6 +692,7 @@ instance StrEncoding ACMEventTag where
"x.grp.del" -> XGrpDel_ "x.grp.del" -> XGrpDel_
"x.grp.info" -> XGrpInfo_ "x.grp.info" -> XGrpInfo_
"x.grp.direct.inv" -> XGrpDirectInv_ "x.grp.direct.inv" -> XGrpDirectInv_
"x.grp.msg.forward" -> XGrpMsgForward_
"x.info.probe" -> XInfoProbe_ "x.info.probe" -> XInfoProbe_
"x.info.probe.check" -> XInfoProbeCheck_ "x.info.probe.check" -> XInfoProbeCheck_
"x.info.probe.ok" -> XInfoProbeOk_ "x.info.probe.ok" -> XInfoProbeOk_
@ -681,7 +710,6 @@ toCMEventTag :: ChatMsgEvent e -> CMEventTag e
toCMEventTag msg = case msg of toCMEventTag msg = case msg of
XMsgNew _ -> XMsgNew_ XMsgNew _ -> XMsgNew_
XMsgFileDescr _ _ -> XMsgFileDescr_ XMsgFileDescr _ _ -> XMsgFileDescr_
XMsgFileCancel _ -> XMsgFileCancel_
XMsgUpdate {} -> XMsgUpdate_ XMsgUpdate {} -> XMsgUpdate_
XMsgDel {} -> XMsgDel_ XMsgDel {} -> XMsgDel_
XMsgDeleted -> XMsgDeleted_ XMsgDeleted -> XMsgDeleted_
@ -710,6 +738,7 @@ toCMEventTag msg = case msg of
XGrpDel -> XGrpDel_ XGrpDel -> XGrpDel_
XGrpInfo _ -> XGrpInfo_ XGrpInfo _ -> XGrpInfo_
XGrpDirectInv _ _ -> XGrpDirectInv_ XGrpDirectInv _ _ -> XGrpDirectInv_
XGrpMsgForward {} -> XGrpMsgForward_
XInfoProbe _ -> XInfoProbe_ XInfoProbe _ -> XInfoProbe_
XInfoProbeCheck _ -> XInfoProbeCheck_ XInfoProbeCheck _ -> XInfoProbeCheck_
XInfoProbeOk _ -> XInfoProbeOk_ XInfoProbeOk _ -> XInfoProbeOk_
@ -780,7 +809,6 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
msg = \case msg = \case
XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params
XMsgFileDescr_ -> XMsgFileDescr <$> p "msgId" <*> p "fileDescr" XMsgFileDescr_ -> XMsgFileDescr <$> p "msgId" <*> p "fileDescr"
XMsgFileCancel_ -> XMsgFileCancel <$> p "msgId"
XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> opt "ttl" <*> opt "live" XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> opt "ttl" <*> opt "live"
XMsgDel_ -> XMsgDel <$> p "msgId" <*> opt "memberId" XMsgDel_ -> XMsgDel <$> p "msgId" <*> opt "memberId"
XMsgDeleted_ -> pure XMsgDeleted XMsgDeleted_ -> pure XMsgDeleted
@ -809,6 +837,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
XGrpDel_ -> pure XGrpDel XGrpDel_ -> pure XGrpDel
XGrpInfo_ -> XGrpInfo <$> p "groupProfile" XGrpInfo_ -> XGrpInfo <$> p "groupProfile"
XGrpDirectInv_ -> XGrpDirectInv <$> p "connReq" <*> opt "content" XGrpDirectInv_ -> XGrpDirectInv <$> p "connReq" <*> opt "content"
XGrpMsgForward_ -> XGrpMsgForward <$> p "memberId" <*> p "msg" <*> p "msgTs"
XInfoProbe_ -> XInfoProbe <$> p "probe" XInfoProbe_ -> XInfoProbe <$> p "probe"
XInfoProbeCheck_ -> XInfoProbeCheck <$> p "probeHash" XInfoProbeCheck_ -> XInfoProbeCheck <$> p "probeHash"
XInfoProbeOk_ -> XInfoProbeOk <$> p "probe" XInfoProbeOk_ -> XInfoProbeOk <$> p "probe"
@ -840,7 +869,6 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
params = \case params = \case
XMsgNew container -> msgContainerJSON container XMsgNew container -> msgContainerJSON container
XMsgFileDescr msgId' fileDescr -> o ["msgId" .= msgId', "fileDescr" .= fileDescr] XMsgFileDescr msgId' fileDescr -> o ["msgId" .= msgId', "fileDescr" .= fileDescr]
XMsgFileCancel msgId' -> o ["msgId" .= msgId']
XMsgUpdate msgId' content ttl live -> o $ ("ttl" .=? ttl) $ ("live" .=? live) ["msgId" .= msgId', "content" .= content] XMsgUpdate msgId' content ttl live -> o $ ("ttl" .=? ttl) $ ("live" .=? live) ["msgId" .= msgId', "content" .= content]
XMsgDel msgId' memberId -> o $ ("memberId" .=? memberId) ["msgId" .= msgId'] XMsgDel msgId' memberId -> o $ ("memberId" .=? memberId) ["msgId" .= msgId']
XMsgDeleted -> JM.empty XMsgDeleted -> JM.empty
@ -869,6 +897,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
XGrpDel -> JM.empty XGrpDel -> JM.empty
XGrpInfo p -> o ["groupProfile" .= p] XGrpInfo p -> o ["groupProfile" .= p]
XGrpDirectInv connReq content -> o $ ("content" .=? content) ["connReq" .= connReq] XGrpDirectInv connReq content -> o $ ("content" .=? content) ["connReq" .= connReq]
XGrpMsgForward memberId msg msgTs -> o ["memberId" .= memberId, "msg" .= msg, "msgTs" .= msgTs]
XInfoProbe probe -> o ["probe" .= probe] XInfoProbe probe -> o ["probe" .= probe]
XInfoProbeCheck probeHash -> o ["probeHash" .= probeHash] XInfoProbeCheck probeHash -> o ["probeHash" .= probeHash]
XInfoProbeOk probe -> o ["probe" .= probe] XInfoProbeOk probe -> o ["probe" .= probe]
@ -879,3 +908,9 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
XCallEnd callId -> o ["callId" .= callId] XCallEnd callId -> o ["callId" .= callId]
XOk -> JM.empty XOk -> JM.empty
XUnknown _ ps -> ps XUnknown _ ps -> ps
instance ToJSON (ChatMessage 'Json) where
toJSON = (\(AMJson msg) -> toJSON msg) . chatToAppMessage
instance FromJSON (ChatMessage 'Json) where
parseJSON v = appJsonToCM <$?> parseJSON v

View File

@ -98,13 +98,13 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
-- GroupInfo -- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupInfo {membership} -- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}} -- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember -- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages, m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences
FROM group_members m FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id JOIN groups g ON g.group_id = m.group_id

View File

@ -45,6 +45,7 @@ module Simplex.Chat.Store.Groups
getGroupInfoByName, getGroupInfoByName,
getGroupMember, getGroupMember,
getGroupMemberById, getGroupMemberById,
getGroupMemberByMemberId,
getGroupMembers, getGroupMembers,
getGroupMembersForExpiration, getGroupMembersForExpiration,
getGroupCurrentMembersCount, getGroupCurrentMembersCount,
@ -77,6 +78,9 @@ module Simplex.Chat.Store.Groups
createIntroductions, createIntroductions,
updateIntroStatus, updateIntroStatus,
saveIntroInvitation, saveIntroInvitation,
getIntroduction,
getForwardIntroducedMembers,
getForwardInvitedMembers,
createIntroReMember, createIntroReMember,
createIntroToMemberContact, createIntroToMemberContact,
saveMemberInvitation, saveMemberInvitation,
@ -125,6 +129,7 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), (:.) (..)) import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql) import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Messages import Simplex.Chat.Messages
import Simplex.Chat.Protocol (currentChatVersion, groupForwardVRange, supportedChatVRange)
import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Shared import Simplex.Chat.Store.Shared
import Simplex.Chat.Types import Simplex.Chat.Types
@ -140,9 +145,9 @@ import UnliftIO.STM
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow
type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences)) type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences)) type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo
toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) = toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) =
@ -153,16 +158,17 @@ toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, de
in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs} in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs}
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) = toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
let memberProfile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} let memberProfile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
memberSettings = GroupMemberSettings {showMessages} memberSettings = GroupMemberSettings {showMessages}
invitedBy = toInvitedBy userContactId invitedById invitedBy = toInvitedBy userContactId invitedById
activeConn = Nothing activeConn = Nothing
memberChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
in GroupMember {..} in GroupMember {..}
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages) :. (invitedById, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) = toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages) :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences)) Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences))
toMaybeGroupMember _ _ = Nothing toMaybeGroupMember _ _ = Nothing
createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO () createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO ()
@ -257,13 +263,13 @@ getGroupAndMember db User {userId, userContactId} groupMemberId =
-- GroupInfo -- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupInfo {membership} -- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}} -- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember -- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages, m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version c.peer_chat_min_version, c.peer_chat_max_version
@ -308,14 +314,14 @@ createNewGroup db gVar user@User {userId} groupProfile incognitoProfile = Except
(ldn, userId, profileId, True, currentTs, currentTs, currentTs) (ldn, userId, profileId, True, currentTs, currentTs, currentTs)
insertedRowId db insertedRowId db
memberId <- liftIO $ encodedRandomBytes gVar 12 memberId <- liftIO $ encodedRandomBytes gVar 12
membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs supportedChatVRange
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs} pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}
-- | creates a new group record for the group the current user was invited to, or returns an existing one -- | creates a new group record for the group the current user was invited to, or returns an existing one
createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId) createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
createGroupInvitation _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName createGroupInvitation _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName
createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Just Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Just hostConn@Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
liftIO getInvitationGroupId_ >>= \case liftIO getInvitationGroupId_ >>= \case
Nothing -> createGroupInvitation_ Nothing -> createGroupInvitation_
Just gId -> do Just gId -> do
@ -353,8 +359,9 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
"INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?,?,?)" "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?,?,?)"
(profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs) (profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs)
insertedRowId db insertedRowId db
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs let JVersionRange hostVRange = hostConn.peerChatVRange
membership <- createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange
membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs supportedChatVRange
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
pure (GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}, groupMemberId) pure (GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}, groupMemberId)
@ -363,8 +370,8 @@ getHostMemberId_ db User {userId} groupId =
ExceptT . firstRow fromOnly (SEHostMemberIdNotFound groupId) $ ExceptT . firstRow fromOnly (SEHostMemberIdNotFound groupId) $
DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND member_category = ?" (userId, groupId, GCHostMember) DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND member_category = ?" (userId, groupId, GCHostMember)
createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ProfileId -> UTCTime -> ExceptT StoreError IO GroupMember createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> Maybe GroupMemberId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ProfileId -> UTCTime -> VersionRange -> ExceptT StoreError IO GroupMember
createContactMemberInv_ db User {userId, userContactId} groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfileId createdAt = do createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMemberId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfileId createdAt memberChatVRange@(VersionRange minV maxV) = do
incognitoProfile <- forM incognitoProfileId $ \profileId -> getProfileById db userId profileId incognitoProfile <- forM incognitoProfileId $ \profileId -> getProfileById db userId profileId
(localDisplayName, memberProfile) <- case (incognitoProfile, incognitoProfileId) of (localDisplayName, memberProfile) <- case (incognitoProfile, incognitoProfileId) of
(Just profile@LocalProfile {displayName}, Just profileId) -> (Just profile@LocalProfile {displayName}, Just profileId) ->
@ -381,11 +388,13 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me
memberStatus, memberStatus,
memberSettings = defaultMemberSettings, memberSettings = defaultMemberSettings,
invitedBy, invitedBy,
invitedByGroupMemberId,
localDisplayName, localDisplayName,
memberProfile, memberProfile,
memberContactId = Just $ contactId' userOrContact, memberContactId = Just $ contactId' userOrContact,
memberContactProfileId = localProfileId (profile' userOrContact), memberContactProfileId = localProfileId (profile' userOrContact),
activeConn = Nothing activeConn = Nothing,
memberChatVRange = JVersionRange memberChatVRange
} }
where where
insertMember_ :: IO ContactName insertMember_ :: IO ContactName
@ -395,12 +404,14 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me
db db
[sql| [sql|
INSERT INTO group_members INSERT INTO group_members
( group_id, member_id, member_role, member_category, member_status, invited_by, ( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at) user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
VALUES (?,?,?,?,?,?,?,?,?,?,?,?) peer_chat_min_version, peer_chat_max_version)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|] |]
( (groupId, memberId, memberRole, memberCategory, memberStatus, fromInvitedBy userContactId invitedBy) ( (groupId, memberId, memberRole, memberCategory, memberStatus, fromInvitedBy userContactId invitedBy, invitedByGroupMemberId)
:. (userId, localDisplayName' userOrContact, contactId' userOrContact, localProfileId $ profile' userOrContact, createdAt, createdAt) :. (userId, localDisplayName' userOrContact, contactId' userOrContact, localProfileId $ profile' userOrContact, createdAt, createdAt)
:. (minV, maxV)
) )
pure localDisplayName pure localDisplayName
insertMemberIncognitoProfile_ :: ContactName -> ProfileId -> ExceptT StoreError IO ContactName insertMemberIncognitoProfile_ :: ContactName -> ProfileId -> ExceptT StoreError IO ContactName
@ -410,12 +421,14 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me
db db
[sql| [sql|
INSERT INTO group_members INSERT INTO group_members
( group_id, member_id, member_role, member_category, member_status, invited_by, ( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, member_profile_id, created_at, updated_at) user_id, local_display_name, contact_id, contact_profile_id, member_profile_id, created_at, updated_at,
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?) peer_chat_min_version, peer_chat_max_version)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|] |]
( (groupId, memberId, memberRole, memberCategory, memberStatus, fromInvitedBy userContactId invitedBy) ( (groupId, memberId, memberRole, memberCategory, memberStatus, fromInvitedBy userContactId invitedBy, invitedByGroupMemberId)
:. (userId, incognitoLdn, contactId' userOrContact, localProfileId $ profile' userOrContact, customUserProfileId, createdAt, createdAt) :. (userId, incognitoLdn, contactId' userOrContact, localProfileId $ profile' userOrContact, customUserProfileId, createdAt, createdAt)
:. (minV, maxV)
) )
pure $ Right incognitoLdn pure $ Right incognitoLdn
@ -430,7 +443,7 @@ createGroupInvitedViaLink
hostMemberId <- insertHost_ currentTs groupId hostMemberId <- insertHost_ currentTs groupId
liftIO $ DB.execute db "UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnMember, hostMemberId, currentTs, connId) liftIO $ DB.execute db "UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnMember, hostMemberId, currentTs, connId)
-- using IBUnknown since host is created without contact -- using IBUnknown since host is created without contact
void $ createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs supportedChatVRange
liftIO $ setViaGroupLinkHash db groupId connId liftIO $ setViaGroupLinkHash db groupId connId
(,) <$> getGroupInfo db user groupId <*> getGroupMemberById db user hostMemberId (,) <$> getGroupInfo db user groupId <*> getGroupMemberById db user hostMemberId
where where
@ -552,8 +565,8 @@ getUserGroupDetails db User {userId, userContactId} _contactId_ search_ =
db db
[sql| [sql|
SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
mu.group_member_id, g.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages,
mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g FROM groups g
JOIN group_profiles gp USING (group_profile_id) JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu USING (group_id) JOIN group_members mu USING (group_id)
@ -617,8 +630,8 @@ groupMemberQuery :: Query
groupMemberQuery = groupMemberQuery =
[sql| [sql|
SELECT SELECT
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages, m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version c.peer_chat_min_version, c.peer_chat_max_version
@ -647,6 +660,14 @@ getGroupMemberById db user@User {userId} groupMemberId =
(groupMemberQuery <> " WHERE m.group_member_id = ? AND m.user_id = ?") (groupMemberQuery <> " WHERE m.group_member_id = ? AND m.user_id = ?")
(userId, groupMemberId, userId) (userId, groupMemberId, userId)
getGroupMemberByMemberId :: DB.Connection -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMember
getGroupMemberByMemberId db user@User {userId} GroupInfo {groupId} memberId =
ExceptT . firstRow (toContactMember user) (SEGroupMemberNotFoundByMemberId memberId) $
DB.query
db
(groupMemberQuery <> " WHERE m.group_id = ? AND m.member_id = ?")
(userId, groupId, memberId)
getGroupMembers :: DB.Connection -> User -> GroupInfo -> IO [GroupMember] getGroupMembers :: DB.Connection -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers db user@User {userId, userContactId} GroupInfo {groupId} = do getGroupMembers db user@User {userId, userContactId} GroupInfo {groupId} = do
map (toContactMember user) map (toContactMember user)
@ -705,15 +726,17 @@ getGroupInvitation db user groupId =
firstRow fromOnly (SEGroupNotFound groupId) $ firstRow fromOnly (SEGroupNotFound groupId) $
DB.query db "SELECT g.inv_queue_info FROM groups g WHERE g.group_id = ? AND g.user_id = ?" (groupId, userId) DB.query db "SELECT g.inv_queue_info FROM groups g WHERE g.group_id = ? AND g.user_id = ?" (groupId, userId)
createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createNewContactMember _ _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ _ _ = throwError $ SEContactNotReady localDisplayName createNewContactMember _ _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ _ _ = throwError $ SEContactNotReady localDisplayName
createNewContactMember db gVar User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile, activeConn = Just Connection {peerChatVRange}} memberRole agentConnId connRequest subMode = createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile, activeConn = Just Connection {peerChatVRange}} memberRole agentConnId connRequest subMode =
createWithRandomId gVar $ \memId -> do createWithRandomId gVar $ \memId -> do
createdAt <- liftIO getCurrentTime createdAt <- liftIO getCurrentTime
member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt
void $ createMemberConnection_ db userId groupMemberId agentConnId (fromJVersionRange peerChatVRange) Nothing 0 createdAt subMode void $ createMemberConnection_ db userId groupMemberId agentConnId (fromJVersionRange peerChatVRange) Nothing 0 createdAt subMode
pure member pure member
where where
JVersionRange (VersionRange minV maxV) = peerChatVRange
invitedByGroupMemberId = groupMemberId' membership
createMember_ memberId createdAt = do createMember_ memberId createdAt = do
insertMember_ insertMember_
groupMemberId <- liftIO $ insertedRowId db groupMemberId <- liftIO $ insertedRowId db
@ -727,11 +750,13 @@ createNewContactMember db gVar User {userId, userContactId} groupId Contact {con
memberStatus = GSMemInvited, memberStatus = GSMemInvited,
memberSettings = defaultMemberSettings, memberSettings = defaultMemberSettings,
invitedBy = IBUser, invitedBy = IBUser,
invitedByGroupMemberId = Just invitedByGroupMemberId,
localDisplayName, localDisplayName,
memberProfile = profile, memberProfile = profile,
memberContactId = Just contactId, memberContactId = Just contactId,
memberContactProfileId = localProfileId profile, memberContactProfileId = localProfileId profile,
activeConn = Nothing activeConn = Nothing,
memberChatVRange = peerChatVRange
} }
where where
insertMember_ = insertMember_ =
@ -739,16 +764,18 @@ createNewContactMember db gVar User {userId, userContactId} groupId Contact {con
db db
[sql| [sql|
INSERT INTO group_members INSERT INTO group_members
( group_id, member_id, member_role, member_category, member_status, invited_by, ( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, sent_inv_queue_info, created_at, updated_at) user_id, local_display_name, contact_id, contact_profile_id, sent_inv_queue_info, created_at, updated_at,
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?) peer_chat_min_version, peer_chat_max_version)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|] |]
( (groupId, memberId, memberRole, GCInviteeMember, GSMemInvited, fromInvitedBy userContactId IBUser) ( (groupId, memberId, memberRole, GCInviteeMember, GSMemInvited, fromInvitedBy userContactId IBUser, invitedByGroupMemberId)
:. (userId, localDisplayName, contactId, localProfileId profile, connRequest, createdAt, createdAt) :. (userId, localDisplayName, contactId, localProfileId profile, connRequest, createdAt, createdAt)
:. (minV, maxV)
) )
createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionRange -> SubscriptionMode -> ExceptT StoreError IO () createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionRange -> SubscriptionMode -> ExceptT StoreError IO ()
createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) peerChatVRange subMode = createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) peerChatVRange subMode =
createWithRandomId gVar $ \memId -> do createWithRandomId gVar $ \memId -> do
createdAt <- liftIO getCurrentTime createdAt <- liftIO getCurrentTime
insertMember_ (MemberId memId) createdAt insertMember_ (MemberId memId) createdAt
@ -756,17 +783,20 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Co
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt subMode Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt subMode
setCommandConnId db user cmdId connId setCommandConnId db user cmdId connId
where where
VersionRange minV maxV = peerChatVRange
insertMember_ memberId createdAt = insertMember_ memberId createdAt =
DB.execute DB.execute
db db
[sql| [sql|
INSERT INTO group_members INSERT INTO group_members
( group_id, member_id, member_role, member_category, member_status, invited_by, ( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at) user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
VALUES (?,?,?,?,?,?,?,?,?,?,?,?) peer_chat_min_version, peer_chat_max_version)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|] |]
( (groupId, memberId, memberRole, GCInviteeMember, GSMemInvited, fromInvitedBy userContactId IBUser) ( (groupId, memberId, memberRole, GCInviteeMember, GSMemInvited, fromInvitedBy userContactId IBUser, groupMemberId' membership)
:. (userId, localDisplayName, contactId, localProfileId profile, createdAt, createdAt) :. (userId, localDisplayName, contactId, localProfileId profile, createdAt, createdAt)
:. (minV, maxV)
) )
createAcceptedMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> ExceptT StoreError IO (GroupMemberId, MemberId) createAcceptedMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> ExceptT StoreError IO (GroupMemberId, MemberId)
@ -774,8 +804,8 @@ createAcceptedMember
db db
gVar gVar
User {userId, userContactId} User {userId, userContactId}
GroupInfo {groupId} GroupInfo {groupId, membership}
UserContactRequest {localDisplayName, profileId} UserContactRequest {cReqChatVRange, localDisplayName, profileId}
memberRole = do memberRole = do
liftIO $ liftIO $
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName) DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
@ -785,17 +815,20 @@ createAcceptedMember
groupMemberId <- liftIO $ insertedRowId db groupMemberId <- liftIO $ insertedRowId db
pure (groupMemberId, MemberId memId) pure (groupMemberId, MemberId memId)
where where
JVersionRange (VersionRange minV maxV) = cReqChatVRange
insertMember_ memberId createdAt = insertMember_ memberId createdAt =
DB.execute DB.execute
db db
[sql| [sql|
INSERT INTO group_members INSERT INTO group_members
( group_id, member_id, member_role, member_category, member_status, invited_by, ( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at) user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
VALUES (?,?,?,?,?,?,?,?,?,?,?,?) peer_chat_min_version, peer_chat_max_version)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|] |]
( (groupId, memberId, memberRole, GCInviteeMember, GSMemAccepted, fromInvitedBy userContactId IBUser) ( (groupId, memberId, memberRole, GCInviteeMember, GSMemAccepted, fromInvitedBy userContactId IBUser, groupMemberId' membership)
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, createdAt, createdAt) :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, createdAt, createdAt)
:. (minV, maxV)
) )
createAcceptedMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO () createAcceptedMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO ()
@ -864,8 +897,8 @@ updateGroupMemberStatusById db userId groupMemberId memStatus = do
(memStatus, currentTs, userId, groupMemberId) (memStatus, currentTs, userId, groupMemberId)
-- | add new member with profile -- | add new member with profile
createNewGroupMember :: DB.Connection -> User -> GroupInfo -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember createNewGroupMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
createNewGroupMember db user gInfo memInfo@MemberInfo {profile} memCategory memStatus = do createNewGroupMember db user gInfo invitingMember memInfo@MemberInfo {profile} memCategory memStatus = do
currentTs <- liftIO getCurrentTime currentTs <- liftIO getCurrentTime
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user profile currentTs (localDisplayName, memProfileId) <- createNewMemberProfile_ db user profile currentTs
let newMember = let newMember =
@ -874,6 +907,7 @@ createNewGroupMember db user gInfo memInfo@MemberInfo {profile} memCategory memS
memCategory, memCategory,
memStatus, memStatus,
memInvitedBy = IBUnknown, memInvitedBy = IBUnknown,
memInvitedByGroupMemberId = Just $ groupMemberId' invitingMember,
localDisplayName, localDisplayName,
memContactId = Nothing, memContactId = Nothing,
memProfileId memProfileId
@ -896,10 +930,11 @@ createNewMember_
User {userId, userContactId} User {userId, userContactId}
GroupInfo {groupId} GroupInfo {groupId}
NewGroupMember NewGroupMember
{ memInfo = MemberInfo memberId memberRole _ memberProfile, { memInfo = MemberInfo memberId memberRole memChatVRange memberProfile,
memCategory = memberCategory, memCategory = memberCategory,
memStatus = memberStatus, memStatus = memberStatus,
memInvitedBy = invitedBy, memInvitedBy = invitedBy,
memInvitedByGroupMemberId,
localDisplayName, localDisplayName,
memContactId = memberContactId, memContactId = memberContactId,
memProfileId = memberContactProfileId memProfileId = memberContactProfileId
@ -907,18 +942,38 @@ createNewMember_
createdAt = do createdAt = do
let invitedById = fromInvitedBy userContactId invitedBy let invitedById = fromInvitedBy userContactId invitedBy
activeConn = Nothing activeConn = Nothing
mcvr@(VersionRange minV maxV) = maybe chatInitialVRange fromChatVRange memChatVRange
DB.execute DB.execute
db db
[sql| [sql|
INSERT INTO group_members INSERT INTO group_members
(group_id, member_id, member_role, member_category, member_status, (group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
invited_by, user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at) user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
VALUES (?,?,?,?,?,?,?,?,?,?,?,?) peer_chat_min_version, peer_chat_max_version)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|] |]
(groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt) ( (groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, memInvitedByGroupMemberId)
:. (userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt)
:. (minV, maxV)
)
groupMemberId <- insertedRowId db groupMemberId <- insertedRowId db
let memberSettings = defaultMemberSettings pure GroupMember {
pure GroupMember {groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, memberSettings, invitedBy, localDisplayName, memberProfile = toLocalProfile memberContactProfileId memberProfile "", memberContactId, memberContactProfileId, activeConn} groupMemberId,
groupId,
memberId,
memberRole,
memberCategory,
memberStatus,
memberSettings = defaultMemberSettings,
invitedBy,
invitedByGroupMemberId = memInvitedByGroupMemberId,
localDisplayName,
memberProfile = toLocalProfile memberContactProfileId memberProfile "",
memberContactId,
memberContactProfileId,
activeConn,
memberChatVRange = JVersionRange mcvr
}
checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId) checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId)
checkGroupMemberHasItems db User {userId} GroupMember {groupMemberId, groupId} = checkGroupMemberHasItems db User {userId} GroupMember {groupMemberId, groupId} =
@ -965,10 +1020,10 @@ createIntroductions db members toMember = do
db db
[sql| [sql|
INSERT INTO group_member_intros INSERT INTO group_member_intros
(re_group_member_id, to_group_member_id, intro_status, created_at, updated_at) (re_group_member_id, to_group_member_id, intro_status, intro_chat_protocol_version, created_at, updated_at)
VALUES (?,?,?,?,?) VALUES (?,?,?,?,?,?)
|] |]
(groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, ts, ts) (groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, currentChatVersion, ts, ts)
introId <- insertedRowId db introId <- insertedRowId db
pure GroupMemberIntro {introId, reMember, toMember, introStatus = GMIntroPending, introInvitation = Nothing} pure GroupMemberIntro {introId, reMember, toMember, introStatus = GMIntroPending, introInvitation = Nothing}
@ -986,7 +1041,7 @@ updateIntroStatus db introId introStatus = do
saveIntroInvitation :: DB.Connection -> GroupMember -> GroupMember -> IntroInvitation -> ExceptT StoreError IO GroupMemberIntro saveIntroInvitation :: DB.Connection -> GroupMember -> GroupMember -> IntroInvitation -> ExceptT StoreError IO GroupMemberIntro
saveIntroInvitation db reMember toMember introInv = do saveIntroInvitation db reMember toMember introInv = do
intro <- getIntroduction_ db reMember toMember intro <- getIntroduction db reMember toMember
liftIO $ do liftIO $ do
currentTs <- getCurrentTime currentTs <- getCurrentTime
DB.executeNamed DB.executeNamed
@ -1027,8 +1082,8 @@ saveMemberInvitation db GroupMember {groupMemberId} IntroInvitation {groupConnRe
":group_member_id" := groupMemberId ":group_member_id" := groupMemberId
] ]
getIntroduction_ :: DB.Connection -> GroupMember -> GroupMember -> ExceptT StoreError IO GroupMemberIntro getIntroduction :: DB.Connection -> GroupMember -> GroupMember -> ExceptT StoreError IO GroupMemberIntro
getIntroduction_ db reMember toMember = ExceptT $ do getIntroduction db reMember toMember = ExceptT $ do
toIntro toIntro
<$> DB.query <$> DB.query
db db
@ -1045,9 +1100,49 @@ getIntroduction_ db reMember toMember = ExceptT $ do
in Right GroupMemberIntro {introId, reMember, toMember, introStatus, introInvitation} in Right GroupMemberIntro {introId, reMember, toMember, introStatus, introInvitation}
toIntro _ = Left SEIntroNotFound toIntro _ = Left SEIntroNotFound
getForwardIntroducedMembers :: DB.Connection -> User -> GroupMember -> Bool -> IO [GroupMember]
getForwardIntroducedMembers db user invitee highlyAvailable = do
memberIds <- map fromOnly <$> query
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db user) memberIds
where
mId = groupMemberId' invitee
query
| highlyAvailable = DB.query db q (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected)
| otherwise =
DB.query
db
(q <> " AND intro_chat_protocol_version >= ?")
(mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, minVersion groupForwardVRange)
q =
[sql|
SELECT re_group_member_id
FROM group_member_intros
WHERE to_group_member_id = ? AND intro_status NOT IN (?,?,?)
|]
getForwardInvitedMembers :: DB.Connection -> User -> GroupMember -> Bool -> IO [GroupMember]
getForwardInvitedMembers db user forwardMember highlyAvailable = do
memberIds <- map fromOnly <$> query
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db user) memberIds
where
mId = groupMemberId' forwardMember
query
| highlyAvailable = DB.query db q (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected)
| otherwise =
DB.query
db
(q <> " AND intro_chat_protocol_version >= ?")
(mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, minVersion groupForwardVRange)
q =
[sql|
SELECT to_group_member_id
FROM group_member_intros
WHERE re_group_member_id = ? AND intro_status NOT IN (?,?,?)
|]
createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberChatVRange memberProfile) (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memChatVRange memberProfile) (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
let mcvr = maybe chatInitialVRange fromChatVRange memberChatVRange let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
currentTs <- liftIO getCurrentTime currentTs <- liftIO getCurrentTime
newMember <- case directConnIds of newMember <- case directConnIds of
@ -1056,10 +1151,10 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM
liftIO $ setCommandConnId db user directCmdId directConnId liftIO $ setCommandConnId db user directCmdId directConnId
(localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs Nothing (localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs Nothing
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId) liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId)
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Just contactId, memProfileId} pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Just contactId, memProfileId}
Nothing -> do Nothing -> do
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Nothing, memProfileId} pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
liftIO $ do liftIO $ do
member <- createNewMember_ db user gInfo newMember currentTs member <- createNewMember_ db user gInfo newMember currentTs
conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId mcvr memberContactId cLevel currentTs subMode conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId mcvr memberContactId cLevel currentTs subMode
@ -1116,13 +1211,13 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
-- GroupInfo -- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupInfo {membership} -- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}} -- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- via GroupMember -- via GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages, m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version c.peer_chat_min_version, c.peer_chat_max_version
@ -1209,8 +1304,8 @@ getGroupInfo db User {userId, userContactId} groupId =
-- GroupInfo -- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupMember - membership -- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id

View File

@ -23,6 +23,7 @@ module Simplex.Chat.Store.Messages
createNewSndMessage, createNewSndMessage,
createSndMsgDelivery, createSndMsgDelivery,
createNewMessageAndRcvMsgDelivery, createNewMessageAndRcvMsgDelivery,
createNewRcvMessage,
createSndMsgDeliveryEvent, createSndMsgDeliveryEvent,
createRcvMsgDeliveryEvent, createRcvMsgDeliveryEvent,
createPendingGroupMessage, createPendingGroupMessage,
@ -185,25 +186,53 @@ createSndMsgDelivery db sndMsgDelivery messageId = do
createMsgDeliveryEvent_ db msgDeliveryId MDSSndAgent currentTs createMsgDeliveryEvent_ db msgDeliveryId MDSSndAgent currentTs
pure msgDeliveryId pure msgDeliveryId
createNewMessageAndRcvMsgDelivery :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> RcvMsgDelivery -> IO RcvMessage createNewMessageAndRcvMsgDelivery :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> RcvMsgDelivery -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
createNewMessageAndRcvMsgDelivery db connOrGroupId NewMessage {chatMsgEvent, msgBody} sharedMsgId_ RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} = do createNewMessageAndRcvMsgDelivery db connOrGroupId newMessage sharedMsgId_ RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} authorGroupMemberId_ = do
currentTs <- getCurrentTime msg@RcvMessage {msgId} <- createNewRcvMessage db connOrGroupId newMessage sharedMsgId_ authorGroupMemberId_ Nothing
DB.execute liftIO $ do
db currentTs <- getCurrentTime
"INSERT INTO messages (msg_sent, chat_msg_event, msg_body, created_at, updated_at, connection_id, group_id, shared_msg_id) VALUES (?,?,?,?,?,?,?,?)" DB.execute
(MDRcv, toCMEventTag chatMsgEvent, msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_) db
msgId <- insertedRowId db "INSERT INTO msg_deliveries (message_id, connection_id, agent_msg_id, agent_msg_meta, agent_ack_cmd_id, chat_ts, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
DB.execute (msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs)
db msgDeliveryId <- insertedRowId db
"INSERT INTO msg_deliveries (message_id, connection_id, agent_msg_id, agent_msg_meta, agent_ack_cmd_id, chat_ts, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent currentTs
(msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs) pure msg
msgDeliveryId <- insertedRowId db
createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent currentTs createNewRcvMessage :: forall e. (MsgEncodingI e) => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
pure RcvMessage {msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody} createNewRcvMessage db connOrGroupId NewMessage{chatMsgEvent, msgBody} sharedMsgId_ authorGroupMemberId forwardedByGroupMemberId =
where case connOrGroupId of
(connId_, groupId_) = case connOrGroupId of ConnectionId connId -> liftIO $ insertRcvMsg (Just connId) Nothing
ConnectionId connId' -> (Just connId', Nothing) GroupId groupId -> case sharedMsgId_ of
GroupId groupId -> (Nothing, Just groupId) Just sharedMsgId -> liftIO (duplicateGroupMsgMemberIds groupId sharedMsgId) >>= \case
Just (duplAuthorId, duplFwdMemberId) ->
throwError $ SEDuplicateGroupMessage groupId sharedMsgId duplAuthorId duplFwdMemberId
Nothing -> liftIO $ insertRcvMsg Nothing $ Just groupId
Nothing -> liftIO $ insertRcvMsg Nothing $ Just groupId
where
duplicateGroupMsgMemberIds :: Int64 -> SharedMsgId -> IO (Maybe (Maybe GroupMemberId, Maybe GroupMemberId))
duplicateGroupMsgMemberIds groupId sharedMsgId =
maybeFirstRow id
$ DB.query
db
[sql|
SELECT author_group_member_id, forwarded_by_group_member_id
FROM messages
WHERE group_id = ? AND shared_msg_id = ? LIMIT 1
|]
(groupId, sharedMsgId)
insertRcvMsg connId_ groupId_ = do
currentTs <- getCurrentTime
DB.execute
db
[sql|
INSERT INTO messages
(msg_sent, chat_msg_event, msg_body, created_at, updated_at, connection_id, group_id, shared_msg_id, author_group_member_id, forwarded_by_group_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?)
|]
(MDRcv, toCMEventTag chatMsgEvent, msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_, authorGroupMemberId, forwardedByGroupMemberId)
msgId <- insertedRowId db
pure RcvMessage{msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody, authorGroupMemberId, forwardedByGroupMemberId}
createSndMsgDeliveryEvent :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> ExceptT StoreError IO () createSndMsgDeliveryEvent :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> ExceptT StoreError IO ()
createSndMsgDeliveryEvent db connId agentMsgId sndMsgDeliveryStatus = do createSndMsgDeliveryEvent db connId agentMsgId sndMsgDeliveryStatus = do
@ -322,7 +351,7 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti
createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId
createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem timed live createdAt = createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem timed live createdAt =
createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow timed live createdAt createdAt createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow timed live createdAt Nothing createdAt
where where
createdByMsgId = if msgId == 0 then Nothing else Just msgId createdByMsgId = if msgId == 0 then Nothing else Just msgId
quoteRow :: NewQuoteRow quoteRow :: NewQuoteRow
@ -337,8 +366,8 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
CIQGroupRcv Nothing -> (Just False, Nothing) CIQGroupRcv Nothing -> (Just False, Nothing)
createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c)) createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c))
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} sharedMsgId_ ciContent timed live itemTs createdAt = do createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByGroupMemberId} sharedMsgId_ ciContent timed live itemTs createdAt = do
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs createdAt ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs forwardedByGroupMemberId createdAt
quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
pure (ciId, quotedItem) pure (ciId, quotedItem)
where where
@ -353,14 +382,14 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} shar
(Just $ Just userMemberId == memberId, memberId) (Just $ Just userMemberId == memberId, memberId)
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId
createNewChatItemNoMsg db user chatDirection ciContent = createNewChatItemNoMsg db user chatDirection ciContent itemTs =
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing False createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing False itemTs Nothing
where where
quoteRow :: NewQuoteRow quoteRow :: NewQuoteRow
quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing) quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO ChatItemId createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CITimed -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs createdAt = do createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs forwardedByGroupMemberId createdAt = do
DB.execute DB.execute
db db
[sql| [sql|
@ -368,18 +397,18 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
-- user and IDs -- user and IDs
user_id, created_by_msg_id, contact_id, group_id, group_member_id, user_id, created_by_msg_id, contact_id, group_id, group_member_id,
-- meta -- meta
item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at, item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, forwarded_by_group_member_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at,
-- quote -- quote
quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|] |]
((userId, msgId_) :. idsRow :. itemRow :. quoteRow) ((userId, msgId_) :. idsRow :. itemRow :. quoteRow)
ciId <- insertedRowId db ciId <- insertedRowId db
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db ciId msgId createdAt forM_ msgId_ $ \msgId -> insertChatItemMessage_ db ciId msgId createdAt
pure ciId pure ciId
where where
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime) itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, forwardedByGroupMemberId) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64) idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64)
idsRow = case chatDirection of idsRow = case chatDirection of
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing) CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing)
@ -440,8 +469,8 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
[sql| [sql|
SELECT i.chat_item_id, SELECT i.chat_item_id,
-- GroupMember -- GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, m.member_status, m.show_messages, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences
FROM group_members m FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
@ -556,8 +585,8 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
-- GroupInfo -- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupMember - membership -- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- ChatStats -- ChatStats
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat,
@ -565,19 +594,21 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live, i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
-- CIFile -- CIFile
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol, f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
-- CIMeta forwardedByGroupMemberId
i.forwarded_by_group_member_id,
-- Maybe GroupMember - sender -- Maybe GroupMember - sender
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, m.member_status, m.show_messages, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
-- quoted ChatItem -- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember -- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, rm.group_member_id, rm.group_id, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
rm.member_status, rm.show_messages, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id, rm.member_status, rm.show_messages, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences, rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
-- deleted by GroupMember -- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category, dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id, dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
FROM groups g FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
@ -1020,7 +1051,7 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
DBCINotDeleted -> Nothing DBCINotDeleted -> Nothing
_ -> Just (CIDeleted @'CTDirect deletedTs) _ -> Just (CIDeleted @'CTDirect deletedTs)
itemEdited' = fromMaybe False itemEdited itemEdited' = fromMaybe False itemEdited
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
ciTimed :: Maybe CITimed ciTimed :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
@ -1031,7 +1062,7 @@ toDirectChatItemList _ _ = []
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow type MaybeGroupChatItemRow = MaybeChatItemRow :. Only (Maybe GroupMemberId) :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow
toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup) toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction quotedSent quotedMember_ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction quotedSent quotedMember_
@ -1042,8 +1073,8 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction
direction _ _ = Nothing direction _ _ = Nothing
-- this function can be changed so it never fails, not only avoid failure on invalid json -- this function can be changed so it never fails, not only avoid failure on invalid json
toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup) toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. Only (Maybe GroupMemberId) :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. Only forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
chatItem $ fromRight invalid $ dbParseACIContent itemContentText chatItem $ fromRight invalid $ dbParseACIContent itemContentText
where where
member_ = toMaybeGroupMember userContactId memberRow_ member_ = toMaybeGroupMember userContactId memberRow_
@ -1079,13 +1110,13 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
DBCIBlocked -> Just (CIBlocked deletedTs) DBCIBlocked -> Just (CIBlocked deletedTs)
_ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_) _ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
itemEdited' = fromMaybe False itemEdited itemEdited' = fromMaybe False itemEdited
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByGroupMemberId createdAt updatedAt
ciTimed :: Maybe CITimed ciTimed :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup] toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
toGroupChatItemList _ _ _ = [] toGroupChatItemList _ _ _ = []
getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem] getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
@ -1529,19 +1560,21 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live, i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
-- CIFile -- CIFile
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol, f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
-- CIMeta forwardedByGroupMemberId
i.forwarded_by_group_member_id,
-- GroupMember -- GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, m.member_status, m.show_messages, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
-- quoted ChatItem -- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember -- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, rm.group_member_id, rm.group_id, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
rm.member_status, rm.show_messages, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id, rm.member_status, rm.show_messages, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences, rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
-- deleted by GroupMember -- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category, dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id, dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
FROM chat_items i FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN files f ON f.chat_item_id = i.chat_item_id

View File

@ -88,6 +88,7 @@ import Simplex.Chat.Migrations.M20231010_member_settings
import Simplex.Chat.Migrations.M20231019_indexes import Simplex.Chat.Migrations.M20231019_indexes
import Simplex.Chat.Migrations.M20231030_xgrplinkmem_received import Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
import Simplex.Chat.Migrations.M20231107_indexes import Simplex.Chat.Migrations.M20231107_indexes
import Simplex.Chat.Migrations.M20231113_group_forward
import Simplex.Chat.Migrations.M20231114_remote_controller import Simplex.Chat.Migrations.M20231114_remote_controller
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
@ -177,6 +178,7 @@ schemaMigrations =
("20231019_indexes", m20231019_indexes, Just down_m20231019_indexes), ("20231019_indexes", m20231019_indexes, Just down_m20231019_indexes),
("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received), ("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received),
("20231107_indexes", m20231107_indexes, Just down_m20231107_indexes), ("20231107_indexes", m20231107_indexes, Just down_m20231107_indexes),
("20231113_group_forward", m20231113_group_forward, Just down_m20231113_group_forward),
("20231114_remote_controller", m20231114_remote_controller, Just down_m20231114_remote_controller) ("20231114_remote_controller", m20231114_remote_controller, Just down_m20231114_remote_controller)
] ]

View File

@ -99,6 +99,7 @@ data StoreError
| SEHostMemberIdNotFound {groupId :: Int64} | SEHostMemberIdNotFound {groupId :: Int64}
| SEContactNotFoundByFileId {fileId :: FileTransferId} | SEContactNotFoundByFileId {fileId :: FileTransferId}
| SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId} | SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId}
| SEDuplicateGroupMessage {groupId :: Int64, sharedMsgId :: SharedMsgId, authorGroupMemberId :: Maybe GroupMemberId, forwardedByGroupMemberId :: Maybe GroupMemberId}
| SERemoteHostNotFound {remoteHostId :: RemoteHostId} | SERemoteHostNotFound {remoteHostId :: RemoteHostId}
| SERemoteHostUnknown -- ^ attempting to store KnownHost without a known fingerprint | SERemoteHostUnknown -- ^ attempting to store KnownHost without a known fingerprint
| SERemoteHostDuplicateCA | SERemoteHostDuplicateCA
@ -208,6 +209,17 @@ setPeerChatVRange db connId (VersionRange minVer maxVer) =
|] |]
(minVer, maxVer, connId) (minVer, maxVer, connId)
setMemberChatVRange :: DB.Connection -> GroupMemberId -> VersionRange -> IO ()
setMemberChatVRange db mId (VersionRange minVer maxVer) =
DB.execute
db
[sql|
UPDATE group_members
SET peer_chat_min_version = ?, peer_chat_max_version = ?
WHERE group_member_id = ?
|]
(minVer, maxVer, mId)
setCommandConnId :: DB.Connection -> User -> CommandId -> Int64 -> IO () setCommandConnId :: DB.Connection -> User -> CommandId -> Int64 -> IO ()
setCommandConnId db User {userId} cmdId connId = do setCommandConnId db User {userId} cmdId connId = do
updatedAt <- getCurrentTime updatedAt <- getCurrentTime

View File

@ -591,9 +591,9 @@ data MemberInfo = MemberInfo
memberInfo :: GroupMember -> MemberInfo memberInfo :: GroupMember -> MemberInfo
memberInfo GroupMember {memberId, memberRole, memberProfile, activeConn} = memberInfo GroupMember {memberId, memberRole, memberProfile, activeConn} =
MemberInfo memberId memberRole memberChatVRange (fromLocalProfile memberProfile) MemberInfo memberId memberRole cvr (fromLocalProfile memberProfile)
where where
memberChatVRange = ChatVersionRange . fromJVersionRange . peerChatVRange <$> activeConn cvr = ChatVersionRange . fromJVersionRange . peerChatVRange <$> activeConn
data ReceivedGroupInvitation = ReceivedGroupInvitation data ReceivedGroupInvitation = ReceivedGroupInvitation
{ fromMember :: GroupMember, { fromMember :: GroupMember,
@ -615,6 +615,7 @@ data GroupMember = GroupMember
memberStatus :: GroupMemberStatus, memberStatus :: GroupMemberStatus,
memberSettings :: GroupMemberSettings, memberSettings :: GroupMemberSettings,
invitedBy :: InvitedBy, invitedBy :: InvitedBy,
invitedByGroupMemberId :: Maybe GroupMemberId,
localDisplayName :: ContactName, localDisplayName :: ContactName,
-- for membership, memberProfile can be either user's profile or incognito profile, based on memberIncognito test. -- for membership, memberProfile can be either user's profile or incognito profile, based on memberIncognito test.
-- for other members it's whatever profile the local user can see (there is no info about whether it's main or incognito profile for remote users). -- for other members it's whatever profile the local user can see (there is no info about whether it's main or incognito profile for remote users).
@ -624,7 +625,10 @@ data GroupMember = GroupMember
-- for membership it would always point to user's contact -- for membership it would always point to user's contact
-- it is used to test for incognito status by comparing with ID in memberProfile -- it is used to test for incognito status by comparing with ID in memberProfile
memberContactProfileId :: ProfileId, memberContactProfileId :: ProfileId,
activeConn :: Maybe Connection activeConn :: Maybe Connection,
-- member chat protocol version range; if member has active connection, its version range is preferred;
-- for membership current supportedChatVRange is set, it's not updated on protocol version increase
memberChatVRange :: JVersionRange
} }
deriving (Eq, Show) deriving (Eq, Show)
@ -636,11 +640,17 @@ groupMemberRef GroupMember {groupMemberId, memberProfile = p} =
GroupMemberRef {groupMemberId, profile = fromLocalProfile p} GroupMemberRef {groupMemberId, profile = fromLocalProfile p}
memberConn :: GroupMember -> Maybe Connection memberConn :: GroupMember -> Maybe Connection
memberConn GroupMember{activeConn} = activeConn memberConn GroupMember {activeConn} = activeConn
memberConnId :: GroupMember -> Maybe ConnId memberConnId :: GroupMember -> Maybe ConnId
memberConnId GroupMember {activeConn} = aConnId <$> activeConn memberConnId GroupMember {activeConn} = aConnId <$> activeConn
memberChatVRange' :: GroupMember -> VersionRange
memberChatVRange' GroupMember {activeConn, memberChatVRange} =
fromJVersionRange $ case activeConn of
Just Connection {peerChatVRange} -> peerChatVRange
Nothing -> memberChatVRange
groupMemberId' :: GroupMember -> GroupMemberId groupMemberId' :: GroupMember -> GroupMemberId
groupMemberId' GroupMember {groupMemberId} = groupMemberId groupMemberId' GroupMember {groupMemberId} = groupMemberId
@ -664,6 +674,7 @@ data NewGroupMember = NewGroupMember
memCategory :: GroupMemberCategory, memCategory :: GroupMemberCategory,
memStatus :: GroupMemberStatus, memStatus :: GroupMemberStatus,
memInvitedBy :: InvitedBy, memInvitedBy :: InvitedBy,
memInvitedByGroupMemberId :: Maybe GroupMemberId,
localDisplayName :: ContactName, localDisplayName :: ContactName,
memProfileId :: Int64, memProfileId :: Int64,
memContactId :: Maybe Int64 memContactId :: Maybe Int64
@ -1360,7 +1371,7 @@ data GroupMemberIntroStatus
| GMIntroReConnected | GMIntroReConnected
| GMIntroToConnected | GMIntroToConnected
| GMIntroConnected | GMIntroConnected
deriving (Show) deriving (Eq, Show)
instance FromField GroupMemberIntroStatus where fromField = fromTextField_ introStatusT instance FromField GroupMemberIntroStatus where fromField = fromTextField_ introStatusT

View File

@ -509,7 +509,7 @@ viewChats ts tz = concatMap chatPreview . reverse
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString] viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} doShow ts tz = viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} doShow ts tz =
withItemDeleted <$> case chat of withGroupMsgForwarded . withItemDeleted <$> (case chat of
DirectChat c -> case chatDir of DirectChat c -> case chatDir of
CIDirectSnd -> case content of CIDirectSnd -> case content of
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to quote mc CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to quote mc
@ -543,11 +543,14 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
from = ttyFromGroup g m from = ttyFromGroup g m
where where
quote = maybe [] (groupQuote g) quotedItem quote = maybe [] (groupQuote g) quotedItem
_ -> [] _ -> [])
where where
withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of
Nothing -> item Nothing -> item
Just t -> item <> styled (colored Red) (" [" <> t <> "]") Just t -> item <> styled (colored Red) (" [" <> t <> "]")
withGroupMsgForwarded item = case meta.forwardedByGroupMemberId of
Nothing -> item
Just _ -> item <> styled (colored Yellow) (" [>>]" :: String)
withSndFile = withFile viewSentFileInvitation withSndFile = withFile viewSentFileInvitation
withRcvFile = withFile viewReceivedFileInvitation withRcvFile = withFile viewReceivedFileInvitation
withFile view dir l = maybe l (\f -> l <> view dir f ts tz meta) file withFile view dir l = maybe l (\f -> l <> view dir f ts tz meta) file

View File

@ -71,7 +71,8 @@ testOpts =
logServerHosts = False, logServerHosts = False,
logAgent = Nothing, logAgent = Nothing,
logFile = Nothing, logFile = Nothing,
tbqSize = 16 tbqSize = 16,
highlyAvailable = False
}, },
chatCmd = "", chatCmd = "",
chatCmdDelay = 3, chatCmdDelay = 3,

View File

@ -7,12 +7,14 @@ import ChatClient
import ChatTests.Utils import ChatTests.Utils
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_) import Control.Concurrent.Async (concurrently_)
import Control.Monad (when) import Control.Monad (when, void)
import qualified Data.ByteString as B
import qualified Data.Text as T import qualified Data.Text as T
import Simplex.Chat.Controller (ChatConfig (..)) import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..))
import Simplex.Chat.Protocol (supportedChatVRange) import Simplex.Chat.Protocol (supportedChatVRange)
import Simplex.Chat.Store (agentStoreFile, chatStoreFile) import Simplex.Chat.Store (agentStoreFile, chatStoreFile)
import Simplex.Chat.Types (GroupMemberRole (..)) import Simplex.Chat.Types (GroupMemberRole (..))
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Version import Simplex.Messaging.Version
import System.Directory (copyFile) import System.Directory (copyFile)
import System.FilePath ((</>)) import System.FilePath ((</>))
@ -103,6 +105,8 @@ chatGroupTests = do
it "invited member replaces member contact reference if it already exists" testMemberContactInvitedConnectionReplaced it "invited member replaces member contact reference if it already exists" testMemberContactInvitedConnectionReplaced
it "share incognito profile" testMemberContactIncognito it "share incognito profile" testMemberContactIncognito
it "sends and updates profile when creating contact" testMemberContactProfileUpdate it "sends and updates profile when creating contact" testMemberContactProfileUpdate
describe "forwarding messages" $ do
it "admin should forward messages between invitee and introduced" testGroupMsgForward
where where
_0 = supportedChatVRange -- don't create direct connections _0 = supportedChatVRange -- don't create direct connections
_1 = groupCreateDirectVRange _1 = groupCreateDirectVRange
@ -1522,6 +1526,13 @@ testGroupDelayedModeration tmp = do
cath <## "#team: you joined the group" cath <## "#team: you joined the group"
] ]
threadDelay 1000000 threadDelay 1000000
-- imitate not implemented group forwarding
-- (real client wouldn't have forwarding code, but tests use "current code" with configured version,
-- and forwarding client doesn't check compatibility)
void $ withCCTransaction alice $ \db ->
DB.execute_ db "UPDATE group_member_intros SET intro_status='con'"
cath #> "#team hi" -- message is pending for bob cath #> "#team hi" -- message is pending for bob
alice <# "#team cath> hi" alice <# "#team cath> hi"
alice ##> "\\\\ #team @cath hi" alice ##> "\\\\ #team @cath hi"
@ -1561,6 +1572,13 @@ testGroupDelayedModerationFullDelete tmp = do
cath <## "#team: you joined the group" cath <## "#team: you joined the group"
] ]
threadDelay 1000000 threadDelay 1000000
-- imitate not implemented group forwarding
-- (real client wouldn't have forwarding code, but tests use "current code" with configured version,
-- and forwarding client doesn't check compatibility)
void $ withCCTransaction alice $ \db ->
DB.execute_ db "UPDATE group_member_intros SET intro_status='con'"
cath #> "#team hi" -- message is pending for bob cath #> "#team hi" -- message is pending for bob
alice <# "#team cath> hi" alice <# "#team cath> hi"
alice ##> "\\\\ #team @cath hi" alice ##> "\\\\ #team @cath hi"
@ -3644,9 +3662,9 @@ testMemberContactProhibitedRepeatInv =
testMemberContactInvitedConnectionReplaced :: HasCallStack => FilePath -> IO () testMemberContactInvitedConnectionReplaced :: HasCallStack => FilePath -> IO ()
testMemberContactInvitedConnectionReplaced tmp = do testMemberContactInvitedConnectionReplaced tmp = do
withNewTestChat tmp "alice" aliceProfile $ \a -> withTestOutput a $ \alice -> do withNewTestChat tmp "alice" aliceProfile $ \alice -> do
withNewTestChat tmp "bob" bobProfile $ \b -> withTestOutput b $ \bob -> do withNewTestChat tmp "bob" bobProfile $ \bob -> do
withNewTestChat tmp "cath" cathProfile $ \c -> withTestOutput c $ \cath -> do withNewTestChat tmp "cath" cathProfile $ \cath -> do
createGroup3 "team" alice bob cath createGroup3 "team" alice bob cath
alice ##> "/d bob" alice ##> "/d bob"
@ -3881,3 +3899,109 @@ testMemberContactProfileUpdate =
cath #> "#team hello there" cath #> "#team hello there"
alice <# "#team kate> hello there" alice <# "#team kate> hello there"
bob <# "#team kate> hello there" -- updated profile bob <# "#team kate> hello there" -- updated profile
testGroupMsgForward :: HasCallStack => FilePath -> IO ()
testGroupMsgForward =
testChatCfg4 cfg aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> withXFTPServer $ do
createGroup3 "team" alice bob cath
threadDelay 1000000 -- delay so intro_status doesn't get overwritten to connected
void $ withCCTransaction bob $ \db ->
DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3"
void $ withCCTransaction cath $ \db ->
DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3"
void $ withCCTransaction alice $ \db ->
DB.execute_ db "UPDATE group_member_intros SET intro_status='fwd'"
bob #> "#team hi there"
alice <# "#team bob> hi there"
cath <# "#team bob> hi there [>>]"
threadDelay 1000000
cath #> "#team hey team"
alice <# "#team cath> hey team"
bob <# "#team cath> hey team [>>]"
alice ##> "/tail #team 2"
alice <# "#team bob> hi there"
alice <# "#team cath> hey team"
bob ##> "/tail #team 2"
bob <# "#team hi there"
bob <# "#team cath> hey team [>>]"
cath ##> "/tail #team 2"
cath <# "#team bob> hi there [>>]"
cath <# "#team hey team"
bob ##> "! #team hello there"
bob <# "#team [edited] hello there"
alice <# "#team bob> [edited] hello there"
cath <# "#team bob> [edited] hello there" -- TODO show as forwarded
cath ##> "+1 #team hello there"
cath <## "added 👍"
alice <# "#team cath> > bob hello there"
alice <## " + 👍"
bob <# "#team cath> > bob hello there"
bob <## " + 👍"
bob ##> "\\ #team hello there"
bob <## "message marked deleted"
alice <# "#team bob> [marked deleted] hello there"
cath <# "#team bob> [marked deleted] hello there" -- TODO show as forwarded
bob #> "/f #team ./tests/fixtures/test.jpg"
bob <## "use /fc 1 to cancel sending"
bob <## "completed uploading file 1 (test.jpg) for #team"
concurrentlyN_
[ do
alice <# "#team bob> sends file test.jpg (136.5 KiB / 139737 bytes)"
alice <## "use /fr 1 [<dir>/ | <path>] to receive it",
do
cath <# "#team bob> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]"
cath <## "use /fr 1 [<dir>/ | <path>] to receive it [>>]"
]
cath ##> "/fr 1 ./tests/tmp"
cath <## "saving file 1 from bob to ./tests/tmp/test.jpg"
cath <## "started receiving file 1 (test.jpg) from bob"
cath <## "completed receiving file 1 (test.jpg) from bob"
src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src
cath ##> "/mr #team bob member"
cath <## "#team: you changed the role of bob from admin to member"
alice <## "#team: cath changed the role of bob from admin to member"
bob <## "#team: cath changed your role from admin to member" -- TODO show as forwarded
connectUsers cath dan
cath ##> "/a #team dan"
cath <## "invitation to join the group #team sent to dan"
dan <## "#team: cath invites you to join the group as member"
dan <## "use /j team to accept"
dan ##> "/j #team"
dan <## "#team: you joined the group"
concurrentlyN_
[ cath <## "#team: dan joined the group",
do
alice <## "#team: cath added dan (Daniel) to the group (connecting...)"
alice <## "#team: new member dan is connected",
-- bob will not connect to dan, as introductions are not forwarded (yet?)
bob <## "#team: cath added dan (Daniel) to the group (connecting...)", -- TODO show as forwarded
dan <## "#team: member alice (Alice) is connected"
]
dan #> "#team hello all"
alice <# "#team dan> hello all"
-- bob <# "#team dan> hello all [>>]"
cath <# "#team dan> hello all"
bob #> "#team hi all"
alice <# "#team bob> hi all"
cath <# "#team bob> hi all [>>]"
-- dan <# "#team bob> hi all"
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}

View File

@ -122,7 +122,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
it "x.msg.new chat message with chat version range" $ it "x.msg.new chat message with chat version range" $
"{\"v\":\"1-3\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" "{\"v\":\"1-4\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) ##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
it "x.msg.new quote" $ it "x.msg.new quote" $
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}" "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}"
@ -232,13 +232,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" "{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile}
it "x.grp.mem.new with member chat version range" $ it "x.grp.mem.new with member chat version range" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-3\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" "{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-4\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
it "x.grp.mem.intro" $ it "x.grp.mem.intro" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile}
it "x.grp.mem.intro with member chat version range" $ it "x.grp.mem.intro with member chat version range" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-3\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-4\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
it "x.grp.mem.inv" $ it "x.grp.mem.inv" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}" "{\"v\":\"1\",\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}"
@ -250,7 +250,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" "{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq} #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq}
it "x.grp.mem.fwd with member chat version range and w/t directConnReq" $ it "x.grp.mem.fwd with member chat version range and w/t directConnReq" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-3\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" "{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-4\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing} #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing}
it "x.grp.mem.info" $ it "x.grp.mem.info" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" "{\"v\":\"1\",\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}"
@ -276,6 +276,12 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
it "x.grp.direct.inv without content" $ 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-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}" "{\"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-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}"
#==# XGrpDirectInv testConnReq Nothing #==# XGrpDirectInv testConnReq 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
-- (MemberId "\1\2\3\4")
-- (ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))))
-- (systemToUTCTime $ MkSystemTime 1 1)
it "x.info.probe" $ it "x.info.probe" $
"{\"v\":\"1\",\"event\":\"x.info.probe\",\"params\":{\"probe\":\"AQIDBA==\"}}" "{\"v\":\"1\",\"event\":\"x.info.probe\",\"params\":{\"probe\":\"AQIDBA==\"}}"
#==# XInfoProbe (Probe "\1\2\3\4") #==# XInfoProbe (Probe "\1\2\3\4")