diff --git a/simplex-chat.cabal b/simplex-chat.cabal index f26e3432c..c510e7333 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -108,6 +108,7 @@ library Simplex.Chat.Migrations.M20230705_delivery_receipts Simplex.Chat.Migrations.M20230721_group_snd_item_statuses Simplex.Chat.Migrations.M20230814_indexes + Simplex.Chat.Migrations.M20230829_connections_chat_vrange Simplex.Chat.Mobile Simplex.Chat.Mobile.WebRTC Simplex.Chat.Options diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 1fabed45b..1c353f7e8 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -104,6 +104,7 @@ import UnliftIO.Concurrent (forkFinally, forkIO, mkWeakThreadId, threadDelay) import UnliftIO.Directory import UnliftIO.IO (hClose, hSeek, hTell, openFile) import UnliftIO.STM +import Simplex.Messaging.Version defaultChatConfig :: ChatConfig defaultChatConfig = @@ -113,6 +114,7 @@ defaultChatConfig = { tcpPort = undefined, -- agent does not listen to TCP tbqSize = 1024 }, + chatVRange = supportedChatVRange, confirmMigrations = MCConsole, defaultServers = DefaultAgentServers @@ -1290,7 +1292,8 @@ processChatCommand = \case -- [incognito] generate profile to send incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing let profileToSend = userProfileToSend user incognitoProfile Nothing - connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq . directMessage $ XInfo profileToSend + dm <- directMessage $ XInfo profileToSend + connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined $ incognitoProfile $> profileToSend toView $ CRNewContactConnection user conn pure $ CRSentConfirmation user @@ -1430,7 +1433,8 @@ processChatCommand = \case APIJoinGroup groupId -> withUser $ \user@User {userId} -> do ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership}} <- withStore $ \db -> getGroupInvitation db user groupId withChatLock "joinGroup" . procCmd $ do - agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest . directMessage $ XGrpAcpt (memberId (membership :: GroupMember)) + dm <- directMessage $ XGrpAcpt (memberId (membership :: GroupMember)) + agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm withStore' $ \db -> do createMemberConnection db userId fromMember agentConnId updateGroupMemberStatus db userId fromMember GSMemAccepted @@ -1820,7 +1824,8 @@ processChatCommand = \case -- [incognito] generate profile to send incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing let profileToSend = userProfileToSend user incognitoProfile Nothing - connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq $ directMessage (XContact profileToSend $ Just xContactId) + dm <- directMessage (XContact profileToSend $ Just xContactId) + connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId toView $ CRNewContactConnection user conn @@ -2210,7 +2215,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI case (xftpRcvFile, fileConnReq) of -- direct file protocol (Nothing, Just connReq) -> do - connIds <- joinAgentConnectionAsync user True connReq . directMessage $ XFileAcpt fName + connIds <- joinAgentConnectionAsync user True connReq =<< directMessage (XFileAcpt fName) filePath <- getRcvFilePath fileId filePath_ fName True withStoreCtx (Just "acceptFileReceive, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath -- XFTP @@ -2325,17 +2330,18 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f) acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact -acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile = do +acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile = do let profileToSend = profileToSendOnAccept user incognitoProfile - acId <- withAgent $ \a -> acceptContact a True invId . directMessage $ XInfo profileToSend - withStore' $ \db -> createAcceptedContact db user acId cName profileId cp userContactLinkId xContactId incognitoProfile + dm <- directMessage $ XInfo profileToSend + acId <- withAgent $ \a -> acceptContact a True invId dm + withStore' $ \db -> createAcceptedContact db user acId cReqChatVRange cName profileId cp userContactLinkId xContactId incognitoProfile acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact -acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do +acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do let profileToSend = profileToSendOnAccept user incognitoProfile (cmdId, acId) <- agentAcceptContactAsync user True invId $ XInfo profileToSend withStore' $ \db -> do - ct@Contact {activeConn = Connection {connId}} <- createAcceptedContact db user acId cName profileId p userContactLinkId xContactId incognitoProfile + ct@Contact {activeConn = Connection {connId}} <- createAcceptedContact db user acId cReqChatVRange cName profileId p userContactLinkId xContactId incognitoProfile setCommandConnId db user cmdId connId pure ct @@ -2825,15 +2831,17 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- [incognito] send saved profile incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing - saveConnInfo conn connInfo + conn' <- saveConnInfo conn connInfo -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn confId $ XInfo profileToSend - INFO connInfo -> - saveConnInfo conn connInfo + allowAgentConnectionAsync user conn' confId $ XInfo profileToSend + INFO connInfo -> do + _conn' <- saveConnInfo conn connInfo + pure () MSG meta _msgFlags msgBody -> do cmdId <- createAckCmd conn - withAckMessage agentConnId cmdId meta $ - saveRcvMSG conn (ConnectionId connId) meta msgBody cmdId $> False + withAckMessage agentConnId cmdId meta $ do + (_conn', _) <- saveRcvMSG conn (ConnectionId connId) meta msgBody cmdId + pure False SENT msgId -> sentMsgDeliveryEvent conn msgId OK -> @@ -2863,49 +2871,52 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do MSG msgMeta _msgFlags msgBody -> do cmdId <- createAckCmd conn withAckMessage agentConnId cmdId msgMeta $ do - msg@RcvMessage {chatMsgEvent = ACME _ event} <- saveRcvMSG conn (ConnectionId connId) msgMeta msgBody cmdId - assertDirectAllowed user MDRcv ct $ toCMEventTag event + (conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveRcvMSG conn (ConnectionId connId) msgMeta msgBody cmdId + let ct' = ct {activeConn = conn'} :: Contact + assertDirectAllowed user MDRcv ct' $ toCMEventTag event updateChatLock "directMessage" event case event of - XMsgNew mc -> newContentMessage ct mc msg 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 - XMsgDel sharedMsgId _ -> messageDelete ct sharedMsgId msg msgMeta - XMsgReact sharedMsgId _ reaction add -> directMsgReaction ct sharedMsgId reaction add msg msgMeta + XMsgNew mc -> newContentMessage ct' mc msg 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 + XMsgDel sharedMsgId _ -> messageDelete ct' sharedMsgId msg msgMeta + XMsgReact sharedMsgId _ reaction add -> directMsgReaction ct' sharedMsgId reaction add msg msgMeta -- TODO discontinue XFile - XFile fInv -> processFileInvitation' ct fInv msg msgMeta - XFileCancel sharedMsgId -> xFileCancel ct sharedMsgId msgMeta - XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInv ct sharedMsgId fileConnReq_ fName msgMeta - XInfo p -> xInfo ct p - XGrpInv gInv -> processGroupInvitation ct gInv msg msgMeta - XInfoProbe probe -> xInfoProbe ct probe - XInfoProbeCheck probeHash -> xInfoProbeCheck ct probeHash - XInfoProbeOk probe -> xInfoProbeOk ct probe - XCallInv callId invitation -> xCallInv ct callId invitation msg msgMeta - XCallOffer callId offer -> xCallOffer ct callId offer msg msgMeta - XCallAnswer callId answer -> xCallAnswer ct callId answer msg msgMeta - XCallExtra callId extraInfo -> xCallExtra ct callId extraInfo msg msgMeta - XCallEnd callId -> xCallEnd ct callId msg msgMeta - BFileChunk sharedMsgId chunk -> bFileChunk ct sharedMsgId chunk msgMeta + XFile fInv -> processFileInvitation' ct' fInv msg msgMeta + XFileCancel sharedMsgId -> xFileCancel ct' sharedMsgId msgMeta + XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInv ct' sharedMsgId fileConnReq_ fName msgMeta + XInfo p -> xInfo ct' p + XGrpInv gInv -> processGroupInvitation ct' gInv msg msgMeta + XInfoProbe probe -> xInfoProbe ct' probe + XInfoProbeCheck probeHash -> xInfoProbeCheck ct' probeHash + XInfoProbeOk probe -> xInfoProbeOk ct' probe + XCallInv callId invitation -> xCallInv ct' callId invitation msg msgMeta + XCallOffer callId offer -> xCallOffer ct' callId offer msg msgMeta + XCallAnswer callId answer -> xCallAnswer ct' callId answer msg msgMeta + XCallExtra callId extraInfo -> xCallExtra ct' callId extraInfo msg msgMeta + XCallEnd callId -> xCallEnd ct' callId msg msgMeta + BFileChunk sharedMsgId chunk -> bFileChunk ct' sharedMsgId chunk msgMeta _ -> messageError $ "unsupported message: " <> T.pack (show event) - let Contact {chatSettings = ChatSettings {sendRcpts}} = ct + let Contact {chatSettings = ChatSettings {sendRcpts}} = ct' pure $ fromMaybe (sendRcptsContacts user) sendRcpts && hasDeliveryReceipt (toCMEventTag event) RCVD msgMeta msgRcpt -> withAckMessage' agentConnId conn msgMeta $ directMsgReceived ct conn msgMeta msgRcpt CONF confId _ connInfo -> do -- confirming direct connection with a member - ChatMessage {chatMsgEvent} <- parseChatMessage conn connInfo + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + conn' <- updateConnChatVRange conn chatVRange case chatMsgEvent of XGrpMemInfo _memId _memProfile -> do -- TODO check member ID -- TODO update member profile -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn confId XOk + allowAgentConnectionAsync user conn' confId XOk _ -> messageError "CONF from member must have x.grp.mem.info" INFO connInfo -> do - ChatMessage {chatMsgEvent} <- parseChatMessage conn connInfo + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + _conn' <- updateConnChatVRange conn chatVRange case chatMsgEvent of XGrpMemInfo _memId _memProfile -> do -- TODO check member ID @@ -3031,7 +3042,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do _ -> throwChatError $ CECommandError "unexpected cmdFunction" CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" CONF confId _ connInfo -> do - ChatMessage {chatMsgEvent} <- parseChatMessage conn connInfo + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + conn' <- updateConnChatVRange conn chatVRange case memberCategory m of GCInviteeMember -> case chatMsgEvent of @@ -3039,7 +3051,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do | sameMemberId memId m -> do withStore $ \db -> liftIO $ updateGroupMemberStatus db userId m GSMemAccepted -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn confId XOk + allowAgentConnectionAsync user conn' confId XOk | otherwise -> messageError "x.grp.acpt: memberId is different from expected" _ -> messageError "CONF from invited member must have x.grp.acpt" _ -> @@ -3048,11 +3060,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do | sameMemberId memId m -> do -- TODO update member profile -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn confId $ XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership) + allowAgentConnectionAsync user conn' confId $ XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership) | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" _ -> messageError "CONF from member must have x.grp.mem.info" INFO connInfo -> do - ChatMessage {chatMsgEvent} <- parseChatMessage conn connInfo + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + _conn' <- updateConnChatVRange conn chatVRange case chatMsgEvent of XGrpMemInfo memId _memProfile | sameMemberId memId m -> do @@ -3110,28 +3123,29 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do MSG msgMeta _msgFlags msgBody -> do cmdId <- createAckCmd conn withAckMessage agentConnId cmdId msgMeta $ do - msg@RcvMessage {chatMsgEvent = ACME _ event} <- saveRcvMSG conn (GroupId groupId) msgMeta msgBody cmdId + (conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveRcvMSG conn (GroupId groupId) msgMeta msgBody cmdId + let m' = m {activeConn = Just conn'} :: GroupMember updateChatLock "groupMessage" event case event of - XMsgNew mc -> canSend $ newGroupContentMessage gInfo m mc msg msgMeta - XMsgFileDescr sharedMsgId fileDescr -> canSend $ groupMessageFileDescription gInfo m sharedMsgId fileDescr msgMeta - XMsgFileCancel sharedMsgId -> cancelGroupMessageFile gInfo m sharedMsgId msgMeta - XMsgUpdate sharedMsgId mContent ttl live -> canSend $ 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 + 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 - 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 + XFile fInv -> processGroupFileInvitation' gInfo m' fInv msg msgMeta + XFileCancel sharedMsgId -> xFileCancelGroup gInfo m' sharedMsgId msgMeta + XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInvGroup gInfo m' sharedMsgId fileConnReq_ fName msgMeta + XGrpMemNew memInfo -> xGrpMemNew gInfo m' memInfo 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 BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta _ -> messageError $ "unsupported message: " <> T.pack (show event) currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo @@ -3141,8 +3155,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do && hasDeliveryReceipt (toCMEventTag event) && currentMemCount <= smallGroupsRcptsMemLimit where - canSend a - | memberRole (m :: GroupMember) <= GRObserver = messageError "member is not allowed to send messages" + canSend mem a + | memberRole (mem :: GroupMember) <= GRObserver = messageError "member is not allowed to send messages" | otherwise = a RCVD msgMeta msgRcpt -> withAckMessage' agentConnId conn msgMeta $ @@ -3227,14 +3241,15 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- SMP CONF for SndFileConnection happens for direct file protocol -- when recipient of the file "joins" connection created by the sender CONF confId _ connInfo -> do - ChatMessage {chatMsgEvent} <- parseChatMessage conn connInfo + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + conn' <- updateConnChatVRange conn chatVRange case chatMsgEvent of -- TODO save XFileAcpt message XFileAcpt name | name == fileName -> do withStore' $ \db -> updateSndFileStatus db ft FSAccepted -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn confId XOk + allowAgentConnectionAsync user conn' confId XOk | otherwise -> messageError "x.file.acpt: fileName is different from expected" _ -> messageError "CONF from file connection must have x.file.acpt" CON -> do @@ -3295,9 +3310,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- when sender of the file "joins" connection created by the recipient -- (sender doesn't create connections for all group members) CONF confId _ connInfo -> do - ChatMessage {chatMsgEvent} <- parseChatMessage conn connInfo + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + conn' <- updateConnChatVRange conn chatVRange case chatMsgEvent of - XOk -> allowAgentConnectionAsync user conn confId XOk -- [async agent commands] no continuation needed, but command should be asynchronous for stability + XOk -> allowAgentConnectionAsync user conn' confId XOk -- [async agent commands] no continuation needed, but command should be asynchronous for stability _ -> pure () CON -> startReceivingFile user fileId MSG meta _ msgBody -> do @@ -3356,10 +3372,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do processUserContactRequest :: ACommand 'Agent e -> ConnectionEntity -> Connection -> UserContact -> m () processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId} = case agentMsg of REQ invId _ connInfo -> do - ChatMessage {chatMsgEvent} <- parseChatMessage conn connInfo + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo case chatMsgEvent of - XContact p xContactId_ -> profileContactRequest invId p xContactId_ - XInfo p -> profileContactRequest invId p Nothing + XContact p xContactId_ -> profileContactRequest invId chatVRange p xContactId_ + XInfo p -> profileContactRequest invId chatVRange p Nothing -- TODO show/log error, other events in contact request _ -> pure () MERR _ err -> do @@ -3371,9 +3387,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- TODO add debugging output _ -> pure () where - profileContactRequest :: InvitationId -> Profile -> Maybe XContactId -> m () - profileContactRequest invId p xContactId_ = do - withStore (\db -> createOrUpdateContactRequest db user userContactLinkId invId p xContactId_) >>= \case + profileContactRequest :: InvitationId -> VersionRange -> Profile -> Maybe XContactId -> m () + profileContactRequest invId chatVRange p xContactId_ = do + withStore (\db -> createOrUpdateContactRequest db user userContactLinkId invId chatVRange p xContactId_) >>= \case CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact CORRequest cReq@UserContactRequest {localDisplayName} -> do withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case @@ -3870,7 +3886,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do then unless cancelled $ case fileConnReq_ of -- receiving via a separate connection Just fileConnReq -> do - connIds <- joinAgentConnectionAsync user True fileConnReq $ directMessage XOk + connIds <- joinAgentConnectionAsync user True fileConnReq =<< directMessage XOk withStore' $ \db -> createSndDirectFTConnection db user fileId connIds -- receiving inline _ -> do @@ -3967,7 +3983,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do (Just fileConnReq, _) -> do -- receiving via a separate connection -- [async agent commands] no continuation needed, but command should be asynchronous for stability - connIds <- joinAgentConnectionAsync user True fileConnReq $ directMessage XOk + connIds <- joinAgentConnectionAsync user True fileConnReq =<< directMessage XOk withStore' $ \db -> createSndGroupFileTransferConnection db user fileId connIds m (_, Just conn) -> do -- receiving inline @@ -3999,7 +4015,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = membership@GroupMember {groupMemberId, memberId}}, hostId) <- withStore $ \db -> createGroupInvitation db user ct inv customUserProfileId if sameGroupLinkId groupLinkId groupLinkId' then do - connIds <- joinAgentConnectionAsync user True connRequest . directMessage $ XGrpAcpt memberId + connIds <- joinAgentConnectionAsync user True connRequest =<< directMessage (XGrpAcpt memberId) withStore' $ \db -> do createMemberConnectionAsync db user hostId connIds updateGroupMemberStatusById db userId hostId GSMemAccepted @@ -4201,15 +4217,17 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do withStore' $ \db -> mergeContactRecords db userId c1 c2 toView $ CRContactsMerged user c1 c2 - saveConnInfo :: Connection -> ConnInfo -> m () + saveConnInfo :: Connection -> ConnInfo -> m Connection saveConnInfo activeConn connInfo = do - ChatMessage {chatMsgEvent} <- parseChatMessage activeConn connInfo + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo + conn' <- updateConnChatVRange activeConn chatVRange case chatMsgEvent of XInfo p -> do - ct <- withStore $ \db -> createDirectContact db user activeConn p + ct <- withStore $ \db -> createDirectContact db user conn' p toView $ CRContactConnecting user ct + pure conn' -- TODO show/log error, other events in SMP confirmation - _ -> pure () + _ -> pure conn' xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> RcvMessage -> MsgMeta -> m () xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole memberProfile) msg msgMeta = do @@ -4274,10 +4292,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do Just m' -> pure m' withStore' $ \db -> saveMemberInvitation db toMember introInv -- [incognito] send membership incognito profile, create direct connection as incognito - let msg = XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership) + dm <- directMessage $ XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership) -- [async agent commands] no continuation needed, but commands should be asynchronous for stability - groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq $ directMessage msg - directConnIds <- joinAgentConnectionAsync user enableNtfs directConnReq $ directMessage msg + groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq dm + directConnIds <- joinAgentConnectionAsync user enableNtfs directConnReq dm let customUserProfileId = if memberIncognito membership then Just (localProfileId $ memberProfile membership) else Nothing withStore' $ \db -> createIntroToMemberContact db user m toMember groupConnIds directConnIds customUserProfileId @@ -4419,6 +4437,13 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do toView $ CRChatItemStatusUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) chatItem) _ -> pure () +updateConnChatVRange :: ChatMonad m => Connection -> VersionRange -> m Connection +updateConnChatVRange conn@Connection {connId, connChatVRange} msgChatVRange + | msgChatVRange /= connChatVRange = do + withStore' $ \db -> setConnChatVRange db connId msgChatVRange + pure conn {connChatVRange = msgChatVRange} + | otherwise = pure conn + parseFileDescription :: (ChatMonad m, FilePartyI p) => Text -> m (ValidFileDescription p) parseFileDescription = liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8) @@ -4617,12 +4642,15 @@ sendDirectMessage conn chatMsgEvent connOrGroupId = do createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGroupId -> m SndMessage createSndMessage chatMsgEvent connOrGroupId = do gVar <- asks idsDrg + ChatConfig {chatVRange} <- asks config withStore $ \db -> createNewSndMessage db gVar connOrGroupId $ \sharedMsgId -> - let msgBody = strEncode ChatMessage {msgId = Just sharedMsgId, chatMsgEvent} + let msgBody = strEncode ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent} in NewMessage {chatMsgEvent, msgBody} -directMessage :: MsgEncodingI e => ChatMsgEvent e -> ByteString -directMessage chatMsgEvent = strEncode ChatMessage {msgId = Nothing, chatMsgEvent} +directMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString +directMessage chatMsgEvent = do + ChatConfig {chatVRange} <- asks config + pure $ strEncode ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent} deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m Int64 deliverMessage conn@Connection {connId} cmEventTag msgBody msgId = do @@ -4677,15 +4705,17 @@ sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn _ -> throwChatError $ CEGroupMemberIntroNotFound localDisplayName _ -> pure () -saveRcvMSG :: ChatMonad m => Connection -> ConnOrGroupId -> MsgMeta -> MsgBody -> CommandId -> m RcvMessage +saveRcvMSG :: ChatMonad m => Connection -> ConnOrGroupId -> MsgMeta -> MsgBody -> CommandId -> m (Connection, RcvMessage) saveRcvMSG conn@Connection {connId} connOrGroupId agentMsgMeta msgBody agentAckCmdId = do - ACMsg _ ChatMessage {msgId = sharedMsgId_, chatMsgEvent} <- parseAChatMessage conn agentMsgMeta msgBody + ACMsg _ ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} <- parseAChatMessage conn agentMsgMeta msgBody + conn' <- updateConnChatVRange conn chatVRange let agentMsgId = fst $ recipient agentMsgMeta newMsg = NewMessage {chatMsgEvent, msgBody} rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} - withStoreCtx' + msg <- withStoreCtx' (Just $ "createNewMessageAndRcvMsgDelivery, rcvMsgDelivery: " <> show rcvMsgDelivery <> ", sharedMsgId_: " <> show sharedMsgId_ <> ", msgDeliveryStatus: MDSRcvAgent") $ \db -> createNewMessageAndRcvMsgDelivery db connOrGroupId newMsg sharedMsgId_ rcvMsgDelivery + pure (conn', msg) 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 @@ -4785,13 +4815,15 @@ joinAgentConnectionAsync user enableNtfs cReqUri cInfo = do allowAgentConnectionAsync :: (MsgEncodingI e, ChatMonad m) => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> m () allowAgentConnectionAsync user conn@Connection {connId} confId msg = do cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFAllowConn - withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId $ directMessage msg + dm <- directMessage msg + withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm withStore' $ \db -> updateConnectionStatus db conn ConnAccepted agentAcceptContactAsync :: (MsgEncodingI e, ChatMonad m) => User -> Bool -> InvitationId -> ChatMsgEvent e -> m (CommandId, ConnId) agentAcceptContactAsync user enableNtfs invId msg = do cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact - connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId $ directMessage msg + dm <- directMessage msg + connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId dm pure (cmdId, connId) deleteAgentConnectionAsync :: ChatMonad m => User -> ConnId -> m () diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 615e472f2..b942256c1 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -64,6 +64,7 @@ import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..)) import Simplex.Messaging.Transport (simplexMQVersion) import Simplex.Messaging.Transport.Client (TransportHost) import Simplex.Messaging.Util (allFinally, catchAllErrors, tryAllErrors) +import Simplex.Messaging.Version import System.IO (Handle) import System.Mem.Weak (Weak) import UnliftIO.STM @@ -72,7 +73,7 @@ versionNumber :: String versionNumber = showVersion SC.version versionString :: String -> String -versionString version = "SimpleX Chat v" <> version +versionString ver = "SimpleX Chat v" <> ver updateStr :: String updateStr = "To update run: curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/install.sh | bash" @@ -101,6 +102,7 @@ coreVersionInfo simplexmqCommit = data ChatConfig = ChatConfig { agentConfig :: AgentConfig, + chatVRange :: VersionRange, confirmMigrations :: MigrationConfirmation, defaultServers :: DefaultAgentServers, tbqSize :: Natural, diff --git a/src/Simplex/Chat/Migrations/M20230829_connections_chat_vrange.hs b/src/Simplex/Chat/Migrations/M20230829_connections_chat_vrange.hs new file mode 100644 index 000000000..b657cc648 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20230829_connections_chat_vrange.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20230829_connections_chat_vrange where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20230829_connections_chat_vrange :: Query +m20230829_connections_chat_vrange = + [sql| +ALTER TABLE connections ADD COLUMN chat_vrange_min_version INTEGER NOT NULL DEFAULT 1; +ALTER TABLE connections ADD COLUMN chat_vrange_max_version INTEGER NOT NULL DEFAULT 1; + +ALTER TABLE contact_requests ADD COLUMN chat_vrange_min_version INTEGER NOT NULL DEFAULT 1; +ALTER TABLE contact_requests ADD COLUMN chat_vrange_max_version INTEGER NOT NULL DEFAULT 1; +|] + +down_m20230829_connections_chat_vrange :: Query +down_m20230829_connections_chat_vrange = + [sql| +ALTER TABLE contact_requests DROP COLUMN chat_vrange_max_version; +ALTER TABLE contact_requests DROP COLUMN chat_vrange_min_version; + +ALTER TABLE connections DROP COLUMN chat_vrange_max_version; +ALTER TABLE connections DROP COLUMN chat_vrange_min_version; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 76b7ba4a1..b41d7efe6 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -283,6 +283,8 @@ CREATE TABLE connections( security_code TEXT NULL, security_code_verified_at TEXT NULL, auth_err_counter INTEGER DEFAULT 0 CHECK(auth_err_counter NOT NULL), + chat_vrange_min_version INTEGER NOT NULL DEFAULT 1, + chat_vrange_max_version INTEGER NOT NULL DEFAULT 1, FOREIGN KEY(snd_file_id, connection_id) REFERENCES snd_files(file_id, connection_id) ON DELETE CASCADE @@ -316,6 +318,8 @@ CREATE TABLE contact_requests( user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, updated_at TEXT CHECK(updated_at NOT NULL), xcontact_id BLOB, + chat_vrange_min_version INTEGER NOT NULL DEFAULT 1, + chat_vrange_max_version INTEGER NOT NULL DEFAULT 1, FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON UPDATE CASCADE diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 31d1eb573..5c33eb06c 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -46,6 +46,13 @@ import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON) import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) +import Simplex.Messaging.Version hiding (version) + +currentChatVersion :: Version +currentChatVersion = 2 + +supportedChatVRange :: VersionRange +supportedChatVRange = mkVersionRange 1 currentChatVersion data ConnectionEntity = RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact} @@ -100,9 +107,22 @@ data AppMessage (e :: MsgEncoding) where AMJson :: AppMessageJson -> AppMessage 'Json AMBinary :: AppMessageBinary -> AppMessage 'Binary +newtype ChatVersionRange = ChatVersionRange {fromChatVRange :: VersionRange} deriving (Eq, Show) + +chatInitialVRange :: VersionRange +chatInitialVRange = versionToRange 1 + +instance FromJSON ChatVersionRange where + parseJSON v = ChatVersionRange <$> strParseJSON "ChatVersionRange" v + +instance ToJSON ChatVersionRange where + toJSON (ChatVersionRange vr) = strToJSON vr + toEncoding (ChatVersionRange vr) = strToJEncoding vr + -- chat message is sent as JSON with these properties data AppMessageJson = AppMessageJson - { msgId :: Maybe SharedMsgId, + { v :: Maybe ChatVersionRange, + msgId :: Maybe SharedMsgId, event :: Text, params :: J.Object } @@ -161,7 +181,11 @@ instance ToJSON MsgRef where toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} -data ChatMessage e = ChatMessage {msgId :: Maybe SharedMsgId, chatMsgEvent :: ChatMsgEvent e} +data ChatMessage e = ChatMessage + { chatVRange :: VersionRange, + msgId :: Maybe SharedMsgId, + chatMsgEvent :: ChatMsgEvent e + } deriving (Eq, Show) data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMessage e) @@ -724,17 +748,17 @@ appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary) appBinaryToCM AppMessageBinary {msgId, tag, body} = do eventTag <- strDecode $ B.singleton tag chatMsgEvent <- parseAll (msg eventTag) body - pure ChatMessage {msgId, chatMsgEvent} + pure ChatMessage {chatVRange = chatInitialVRange, msgId, chatMsgEvent} where msg :: CMEventTag 'Binary -> A.Parser (ChatMsgEvent 'Binary) msg = \case BFileChunk_ -> BFileChunk <$> (SharedMsgId <$> smpP) <*> (unIFC <$> smpP) appJsonToCM :: AppMessageJson -> Either String (ChatMessage 'Json) -appJsonToCM AppMessageJson {msgId, event, params} = do +appJsonToCM AppMessageJson {v, msgId, event, params} = do eventTag <- strDecode $ encodeUtf8 event chatMsgEvent <- msg eventTag - pure ChatMessage {msgId, chatMsgEvent} + pure ChatMessage {chatVRange = maybe chatInitialVRange fromChatVRange v, msgId, chatMsgEvent} where p :: FromJSON a => J.Key -> Either String a p key = JT.parseEither (.: key) params @@ -784,11 +808,11 @@ appJsonToCM AppMessageJson {msgId, event, params} = do key .=? value = maybe id ((:) . (key .=)) value chatToAppMessage :: forall e. MsgEncodingI e => ChatMessage e -> AppMessage e -chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of +chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @e of SBinary -> let (binaryMsgId, body) = toBody chatMsgEvent in AMBinary AppMessageBinary {msgId = binaryMsgId, tag = B.head $ strEncode tag, body} - SJson -> AMJson AppMessageJson {msgId, event = textEncode tag, params = params chatMsgEvent} + SJson -> AMJson AppMessageJson {v = Just $ ChatVersionRange chatVRange, msgId, event = textEncode tag, params = params chatMsgEvent} where tag = toCMEventTag chatMsgEvent o :: [(J.Key, J.Value)] -> J.Object @@ -804,7 +828,7 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of XMsgUpdate msgId' content ttl live -> o $ ("ttl" .=? ttl) $ ("live" .=? live) ["msgId" .= msgId', "content" .= content] XMsgDel msgId' memberId -> o $ ("memberId" .=? memberId) ["msgId" .= msgId'] XMsgDeleted -> JM.empty - XMsgReact msgId' memberId reaction add -> o $ ("memberId" .=? memberId) ["msgId" .= msgId', "reaction" .= reaction, "add" .= add] + XMsgReact msgId' memberId reaction add -> o $ ("memberId" .=? memberId) ["msgId" .= msgId', "reaction" .= reaction, "add" .= add] XFile fileInv -> o ["file" .= fileInv] XFileAcpt fileName -> o ["fileName" .= fileName] XFileAcptInv sharedMsgId fileConnReq fileName -> o $ ("fileConnReq" .=? fileConnReq) ["msgId" .= sharedMsgId, "fileName" .= fileName] diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index e31598812..a7c8fd6c3 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -49,7 +49,8 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do db [sql| SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id, - conn_status, conn_type, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, security_code, security_code_verified_at, auth_err_counter + conn_status, conn_type, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, security_code, security_code_verified_at, auth_err_counter, + chat_vrange_min_version, chat_vrange_max_version FROM connections WHERE user_id = ? AND agent_conn_id = ? |] diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index de1c5014b..00d3d55c9 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -75,6 +75,7 @@ import Simplex.Chat.Types.Preferences import Simplex.Messaging.Agent.Protocol (ConnId, InvitationId, UserId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB +import Simplex.Messaging.Version getPendingContactConnection :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO PendingContactConnection getPendingContactConnection db userId connId = do @@ -143,7 +144,8 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, -- Connection 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.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.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.chat_vrange_min_version, c.chat_vrange_max_version FROM contacts ct JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id JOIN connections c ON c.contact_id = ct.contact_id @@ -411,8 +413,8 @@ getUserContacts db user@User {userId} = do contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 0" (Only userId) rights <$> mapM (runExceptT . getContact db user) contactIds -createOrUpdateContactRequest :: DB.Connection -> User -> Int64 -> InvitationId -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest -createOrUpdateContactRequest db user@User {userId} userContactLinkId invId Profile {displayName, fullName, image, contactLink, preferences} xContactId_ = +createOrUpdateContactRequest :: DB.Connection -> User -> Int64 -> InvitationId -> VersionRange -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest +createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ = liftIO (maybeM getContact' xContactId_) >>= \case Just contact -> pure $ CORContact contact Nothing -> CORRequest <$> createOrUpdate_ @@ -441,10 +443,10 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId Profi db [sql| INSERT INTO contact_requests - (user_contact_link_id, agent_invitation_id, contact_profile_id, local_display_name, user_id, created_at, updated_at, xcontact_id) - VALUES (?,?,?,?,?,?,?,?) + (user_contact_link_id, agent_invitation_id, chat_vrange_min_version, chat_vrange_max_version, contact_profile_id, local_display_name, user_id, created_at, updated_at, xcontact_id) + VALUES (?,?,?,?,?,?,?,?,?,?) |] - (userContactLinkId, invId, profileId, ldn, userId, currentTs, currentTs, xContactId_) + (userContactLinkId, invId, minV, maxV, profileId, ldn, userId, currentTs, currentTs, xContactId_) insertedRowId db getContact' :: XContactId -> IO (Maybe Contact) getContact' xContactId = @@ -458,7 +460,8 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId Profi cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, -- Connection 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.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.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.chat_vrange_min_version, c.chat_vrange_max_version FROM contacts ct JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id LEFT JOIN connections c ON c.contact_id = ct.contact_id @@ -475,7 +478,8 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId Profi [sql| SELECT cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id, - c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at + c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at, + cr.chat_vrange_min_version, cr.chat_vrange_max_version FROM contact_requests cr JOIN connections c USING (user_contact_link_id) JOIN contact_profiles p USING (contact_profile_id) @@ -489,10 +493,26 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId Profi currentTs <- liftIO getCurrentTime updateProfile currentTs if displayName == oldDisplayName - then Right <$> DB.execute db "UPDATE contact_requests SET agent_invitation_id = ?, updated_at = ? WHERE user_id = ? AND contact_request_id = ?" (invId, currentTs, userId, cReqId) + then + Right + <$> DB.execute + db + [sql| + UPDATE contact_requests + SET agent_invitation_id = ?, chat_vrange_min_version = ?, chat_vrange_max_version = ?, updated_at = ? + WHERE user_id = ? AND contact_request_id = ? + |] + (invId, minV, maxV, currentTs, userId, cReqId) else withLocalDisplayName db userId displayName $ \ldn -> Right <$> do - DB.execute db "UPDATE contact_requests SET agent_invitation_id = ?, local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_request_id = ?" (invId, ldn, currentTs, userId, cReqId) + DB.execute + db + [sql| + UPDATE contact_requests + SET agent_invitation_id = ?, chat_vrange_min_version = ?, chat_vrange_max_version = ?, local_display_name = ?, updated_at = ? + WHERE user_id = ? AND contact_request_id = ? + |] + (invId, minV, maxV, ldn, currentTs, userId, cReqId) DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (oldLdn, userId) where updateProfile currentTs = @@ -527,7 +547,8 @@ getContactRequest db User {userId} contactRequestId = [sql| SELECT cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id, - c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at + c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at, + cr.chat_vrange_min_version, cr.chat_vrange_max_version FROM contact_requests cr JOIN connections c USING (user_contact_link_id) JOIN contact_profiles p USING (contact_profile_id) @@ -566,8 +587,8 @@ deleteContactRequest db User {userId} contactRequestId = do (userId, userId, contactRequestId) DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId) -createAcceptedContact :: DB.Connection -> User -> ConnId -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> IO Contact -createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId localDisplayName profileId profile userContactLinkId xContactId incognitoProfile = do +createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRange -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> IO Contact +createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile = do DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName) createdAt <- getCurrentTime customUserProfileId <- forM incognitoProfile $ \case @@ -579,7 +600,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences} "INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id) VALUES (?,?,?,?,?,?,?,?,?)" (userId, localDisplayName, profileId, True, userPreferences, createdAt, createdAt, createdAt, xContactId) contactId <- insertedRowId db - activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId Nothing (Just userContactLinkId) customUserProfileId 0 createdAt + activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt} @@ -603,7 +624,8 @@ getContact_ db user@User {userId} contactId deleted = cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, -- Connection 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.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.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.chat_vrange_min_version, c.chat_vrange_max_version FROM contacts ct JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id LEFT JOIN connections c ON c.contact_id = ct.contact_id @@ -651,7 +673,8 @@ getContactConnections db userId Contact {contactId} = db [sql| SELECT 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.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.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.chat_vrange_min_version, c.chat_vrange_max_version FROM connections c JOIN contacts ct ON ct.contact_id = c.contact_id WHERE c.user_id = ? AND ct.user_id = ? AND ct.contact_id = ? @@ -667,7 +690,8 @@ getConnectionById db User {userId} connId = ExceptT $ do db [sql| SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id, - conn_status, conn_type, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, security_code, security_code_verified_at, auth_err_counter + conn_status, conn_type, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, security_code, security_code_verified_at, auth_err_counter, + chat_vrange_min_version, chat_vrange_max_version FROM connections WHERE user_id = ? AND connection_id = ? |] diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index 249dfedc3..4c370d15e 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -421,7 +421,7 @@ getChatRefByFileId db User {userId} fileId = createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> IO Connection createSndFileConnection_ db userId fileId agentConnId = do currentTs <- getCurrentTime - createConnection_ db userId ConnSndFile (Just fileId) agentConnId Nothing Nothing Nothing 0 currentTs + createConnection_ db userId ConnSndFile (Just fileId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs updateSndFileStatus :: DB.Connection -> SndFileTransfer -> FileStatus -> IO () updateSndFileStatus db SndFileTransfer {fileId, connId} status = do diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 32a3b9110..6c2f32f76 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -98,6 +98,7 @@ import Database.SQLite.Simple.QQ (sql) import Simplex.Chat.Messages import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Shared +import Simplex.Chat.Protocol (chatInitialVRange) import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Messaging.Agent.Protocol (ConnId, UserId) @@ -142,7 +143,7 @@ createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName} "INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" (userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, memberRole, True, currentTs, currentTs) userContactLinkId <- insertedRowId db - void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId Nothing Nothing Nothing 0 currentTs + void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs getGroupLinkConnection :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO Connection getGroupLinkConnection db User {userId} groupInfo@GroupInfo {groupId} = @@ -151,7 +152,8 @@ getGroupLinkConnection db User {userId} groupInfo@GroupInfo {groupId} = db [sql| SELECT 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.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.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.chat_vrange_min_version, c.chat_vrange_max_version FROM connections c JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id WHERE c.user_id = ? AND uc.user_id = ? AND uc.group_id = ? @@ -232,7 +234,8 @@ getGroupAndMember db User {userId, userContactId} groupMemberId = m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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, 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.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.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.chat_vrange_min_version, c.chat_vrange_max_version FROM group_members m 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 @@ -524,7 +527,8 @@ groupMemberQuery = m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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, 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.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.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.chat_vrange_min_version, c.chat_vrange_max_version FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.connection_id = ( @@ -682,7 +686,8 @@ getContactViaMember db user@User {userId} GroupMember {groupMemberId} = cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, -- Connection 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.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.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.chat_vrange_min_version, c.chat_vrange_max_version FROM contacts ct JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id JOIN connections c ON c.connection_id = ( @@ -911,7 +916,7 @@ createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> Memb createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberProfile) (groupCmdId, groupAgentConnId) (directCmdId, directAgentConnId) customUserProfileId = do let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn currentTs <- liftIO getCurrentTime - Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId memberContactId Nothing customUserProfileId cLevel currentTs + Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId chatInitialVRange memberContactId Nothing customUserProfileId cLevel currentTs liftIO $ setCommandConnId db user directCmdId directConnId (localDisplayName, contactId, memProfileId) <- createContact_ db userId directConnId memberProfile "" (Just groupId) currentTs Nothing liftIO $ do @@ -936,7 +941,7 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = currentTs <- getCurrentTime Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId viaContactId cLevel currentTs setCommandConnId db user groupCmdId groupConnId - Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId viaContactId Nothing customUserProfileId cLevel currentTs + Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId chatInitialVRange viaContactId Nothing customUserProfileId cLevel currentTs setCommandConnId db user directCmdId directConnId contactId <- createMemberContact_ directConnId currentTs updateMember_ contactId currentTs @@ -967,7 +972,7 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = [":contact_id" := contactId, ":updated_at" := ts, ":group_member_id" := groupMemberId] createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> Maybe Int64 -> Int -> UTCTime -> IO Connection -createMemberConnection_ db userId groupMemberId agentConnId viaContact = createConnection_ db userId ConnMember (Just groupMemberId) agentConnId viaContact Nothing Nothing +createMemberConnection_ db userId groupMemberId agentConnId viaContact = createConnection_ db userId ConnMember (Just groupMemberId) agentConnId chatInitialVRange viaContact Nothing Nothing getViaGroupMember :: DB.Connection -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember)) getViaGroupMember db User {userId, userContactId} Contact {contactId} = @@ -987,7 +992,8 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} = m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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, 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.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.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.chat_vrange_min_version, c.chat_vrange_max_version FROM group_members m JOIN contacts ct ON ct.contact_id = m.contact_id JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) @@ -1020,7 +1026,8 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, ct.via_group, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite, p.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, 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.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.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.chat_vrange_min_version, c.chat_vrange_max_version FROM contacts ct JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id JOIN connections c ON c.connection_id = ( diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 7bc2eaf4d..5f760add1 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -478,6 +478,7 @@ getDirectChatPreviews_ db user@User {userId} = do -- Connection 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.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.chat_vrange_min_version, c.chat_vrange_max_version, -- ChatStats COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), ct.unread_chat, -- ChatItem @@ -608,7 +609,8 @@ getContactRequestChatPreviews_ db User {userId} = [sql| SELECT cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id, - c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at + c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at, + cr.chat_vrange_min_version, cr.chat_vrange_max_version FROM contact_requests cr JOIN connections c ON c.user_contact_link_id = cr.user_contact_link_id JOIN contact_profiles p ON p.contact_profile_id = cr.contact_profile_id diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index 6da0d1cdc..3bd9bf4f7 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -76,6 +76,7 @@ import Simplex.Chat.Migrations.M20230621_chat_item_moderations import Simplex.Chat.Migrations.M20230705_delivery_receipts import Simplex.Chat.Migrations.M20230721_group_snd_item_statuses import Simplex.Chat.Migrations.M20230814_indexes +import Simplex.Chat.Migrations.M20230829_connections_chat_vrange import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -151,7 +152,8 @@ schemaMigrations = ("20230621_chat_item_moderations", m20230621_chat_item_moderations, Just down_m20230621_chat_item_moderations), ("20230705_delivery_receipts", m20230705_delivery_receipts, Just down_m20230705_delivery_receipts), ("20230721_group_snd_item_statuses", m20230721_group_snd_item_statuses, Just down_m20230721_group_snd_item_statuses), - ("20230814_indexes", m20230814_indexes, Just down_m20230814_indexes) + ("20230814_indexes", m20230814_indexes, Just down_m20230814_indexes), + ("20230829_connections_chat_vrange", m20230829_connections_chat_vrange, Just down_m20230829_connections_chat_vrange) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 48f2dd144..1d305ffd6 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -302,7 +302,7 @@ createUserContactLink db User {userId} agentConnId cReq = "INSERT INTO user_contact_links (user_id, conn_req_contact, created_at, updated_at) VALUES (?,?,?,?)" (userId, cReq, currentTs, currentTs) userContactLinkId <- insertedRowId db - void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId Nothing Nothing Nothing 0 currentTs + void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs getUserAddressConnections :: DB.Connection -> User -> ExceptT StoreError IO [Connection] getUserAddressConnections db User {userId} = do @@ -316,7 +316,8 @@ getUserAddressConnections db User {userId} = do db [sql| SELECT 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.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.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.chat_vrange_min_version, c.chat_vrange_max_version FROM connections c JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id WHERE c.user_id = ? AND uc.user_id = ? AND uc.local_display_name = '' AND uc.group_id IS NULL @@ -331,6 +332,7 @@ getUserContactLinks db User {userId} = [sql| SELECT 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.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.chat_vrange_min_version, c.chat_vrange_max_version, uc.user_contact_link_id, uc.conn_req_contact, uc.group_id FROM connections c JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index c4e6b8d90..5bae79d80 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -17,8 +17,8 @@ import Control.Monad.Except import Crypto.Random (ChaChaDRG, randomBytesGenerate) import Data.Aeson (ToJSON) import qualified Data.Aeson as J -import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Base64 as B64 +import Data.ByteString.Char8 (ByteString) import Data.Int (Int64) import Data.Maybe (fromMaybe, isJust, listToMaybe) import Data.Text (Text) @@ -37,6 +37,7 @@ import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) import Simplex.Messaging.Util (allFinally) +import Simplex.Messaging.Version import UnliftIO.STM -- These error type constructors must be added to mobile apps @@ -132,15 +133,16 @@ toFileInfo (fileId, fileStatus, filePath) = CIFileInfo {fileId, fileStatus, file type EntityIdsRow = (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64) -type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, Int) +type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, Int, Version, Version) -type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe Int) +type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe Int, Maybe Version, Maybe Version) toConnection :: ConnectionRow -> Connection -toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter)) = +toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer)) = let entityId = entityId_ connType connectionCode = SecurityCode <$> code_ <*> verifiedAt_ - in Connection {connId, agentConnId = AgentConnId acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias, entityId, connectionCode, authErrCounter, createdAt} + connChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer + in Connection {connId, agentConnId = AgentConnId acId, connChatVRange, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias, entityId, connectionCode, authErrCounter, createdAt} where entityId_ :: ConnType -> Maybe Int64 entityId_ ConnContact = contactId @@ -150,12 +152,12 @@ toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroup entityId_ ConnUserContact = userContactLinkId toMaybeConnection :: MaybeConnectionRow -> Maybe Connection -toMaybeConnection ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just authErrCounter)) = - Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter)) +toMaybeConnection ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just authErrCounter, Just minVer, Just maxVer)) = + Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer)) toMaybeConnection _ = Nothing -createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> IO Connection -createConnection_ db userId connType entityId acId viaContact viaUserContactLink customUserProfileId connLevel currentTs = do +createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionRange -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> IO Connection +createConnection_ db userId connType entityId acId connChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs = do viaLinkGroupId :: Maybe Int64 <- fmap join . forM viaUserContactLink $ \ucLinkId -> maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM user_contact_links WHERE user_id = ? AND user_contact_link_id = ? AND group_id IS NOT NULL" (userId, ucLinkId) let viaGroupLink = isJust viaLinkGroupId @@ -164,17 +166,30 @@ createConnection_ db userId connType entityId acId viaContact viaUserContactLink [sql| INSERT INTO connections ( user_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, custom_user_profile_id, conn_status, conn_type, - contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, updated_at - ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, updated_at, + chat_vrange_min_version, chat_vrange_max_version + ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] ( (userId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, customUserProfileId, ConnNew, connType) :. (ent ConnContact, ent ConnMember, ent ConnSndFile, ent ConnRcvFile, ent ConnUserContact, currentTs, currentTs) + :. (minV, maxV) ) connId <- insertedRowId db - pure Connection {connId, agentConnId = AgentConnId acId, connType, entityId, viaContact, viaUserContactLink, viaGroupLink, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0} + pure Connection {connId, agentConnId = AgentConnId acId, connChatVRange, connType, entityId, viaContact, viaUserContactLink, viaGroupLink, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0} where ent ct = if connType == ct then entityId else Nothing +setConnChatVRange :: DB.Connection -> Int64 -> VersionRange -> IO () +setConnChatVRange db connId (VersionRange minVer maxVer) = + DB.execute + db + [sql| + UPDATE connections + SET chat_vrange_min_version = ?, chat_vrange_max_version = ? + WHERE connection_id = ? + |] + (minVer, maxVer, connId) + setCommandConnId :: DB.Connection -> User -> CommandId -> Int64 -> IO () setCommandConnId db User {userId} cmdId connId = do updatedAt <- getCurrentTime @@ -256,12 +271,13 @@ getProfileById db userId profileId = toProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences) -> LocalProfile toProfile (displayName, fullName, image, contactLink, localAlias, preferences) = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} -type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact) :. (Maybe XContactId, Maybe Preferences, UTCTime, UTCTime) +type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact) :. (Maybe XContactId, Maybe Preferences, UTCTime, UTCTime, Version, Version) toContactRequest :: ContactRequestRow -> UserContactRequest -toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, preferences, createdAt, updatedAt)) = do +toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, preferences, createdAt, updatedAt, minVer, maxVer)) = do let profile = Profile {displayName, fullName, image, contactLink, preferences} - in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, localDisplayName, profileId, profile, xContactId, createdAt, updatedAt} + cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer + in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, createdAt, updatedAt} userQuery :: Query userQuery = diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index ac71ce612..ac19cbc36 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -46,6 +46,7 @@ import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON, taggedObjectJSON) import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI) import Simplex.Messaging.Util ((<$?>)) +import Simplex.Messaging.Version class IsContact a where contactId' :: a -> ContactId @@ -231,6 +232,7 @@ data UserContactRequest = UserContactRequest agentInvitationId :: AgentInvId, userContactLinkId :: Int64, agentContactConnId :: AgentConnId, -- connection id of user contact + cReqChatVRange :: VersionRange, localDisplayName :: ContactName, profileId :: Int64, profile :: Profile, @@ -1154,6 +1156,7 @@ type ConnReqContact = ConnectionRequestUri 'CMContact data Connection = Connection { connId :: Int64, agentConnId :: AgentConnId, + connChatVRange :: VersionRange, connLevel :: Int, viaContact :: Maybe Int64, -- group member contact ID, if not direct connection viaUserContactLink :: Maybe Int64, -- user contact link ID, if connected via "user address" diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 033b1c9f7..2f512a9b7 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -57,6 +57,7 @@ import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType, Pro import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.Transport.Client (TransportHost (..)) import Simplex.Messaging.Util (bshow, tshow) +import Simplex.Messaging.Version hiding (version) import System.Console.ANSI.Types type CurrentTime = UTCTime @@ -949,7 +950,7 @@ viewNetworkConfig NetworkConfig {socksProxy, tcpTimeout} = ] viewContactInfo :: Contact -> ConnectionStats -> Maybe Profile -> [StyledString] -viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink}} stats incognitoProfile = +viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink}, activeConn} stats incognitoProfile = ["contact ID: " <> sShow contactId] <> viewConnectionStats stats <> maybe [] (\l -> ["contact address: " <> (plain . strEncode) l]) contactLink <> maybe @@ -958,6 +959,7 @@ viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, conta incognitoProfile <> ["alias: " <> plain localAlias | localAlias /= ""] <> [viewConnectionVerified (contactSecurityCode ct)] + <> [viewConnChatVRange (connChatVRange activeConn)] viewGroupInfo :: GroupInfo -> GroupSummary -> [StyledString] viewGroupInfo GroupInfo {groupId} s = @@ -966,18 +968,22 @@ viewGroupInfo GroupInfo {groupId} s = ] viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> [StyledString] -viewGroupMemberInfo GroupInfo {groupId} m@GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias}} stats = +viewGroupMemberInfo GroupInfo {groupId} m@GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias}, activeConn} stats = [ "group ID: " <> sShow groupId, "member ID: " <> sShow groupMemberId ] <> maybe ["member not connected"] viewConnectionStats stats <> ["alias: " <> plain localAlias | localAlias /= ""] <> [viewConnectionVerified (memberSecurityCode m) | isJust stats] + <> maybe [] (\ac -> [viewConnChatVRange (connChatVRange ac)]) activeConn viewConnectionVerified :: Maybe SecurityCode -> StyledString viewConnectionVerified (Just _) = "connection verified" -- TODO show verification time? viewConnectionVerified _ = "connection not verified, use " <> highlight' "/code" <> " command to see security code" +viewConnChatVRange :: VersionRange -> StyledString +viewConnChatVRange (VersionRange minVer maxVer) = "chat protocol version range: (" <> sShow minVer <> ", " <> sShow maxVer <> ")" + viewConnectionStats :: ConnectionStats -> [StyledString] viewConnectionStats ConnectionStats {rcvQueuesInfo, sndQueuesInfo} = ["receiving messages via: " <> viewRcvQueuesInfo rcvQueuesInfo | not $ null rcvQueuesInfo] diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 2384daac3..e7442d90a 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -17,9 +17,11 @@ import qualified Data.ByteString.Lazy.Char8 as LB import Simplex.Chat.Call import Simplex.Chat.Controller (ChatConfig (..)) import Simplex.Chat.Options (ChatOpts (..)) +import Simplex.Chat.Protocol (supportedChatVRange) import Simplex.Chat.Store (agentStoreFile, chatStoreFile) import Simplex.Chat.Types (authErrDisableCount, sameVerificationCode, verificationCode) import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Version import System.Directory (copyFile, doesDirectoryExist, doesFileExist) import System.FilePath (()) import Test.Hspec @@ -94,6 +96,21 @@ chatDirectTests = do describe "delivery receipts" $ do it "should send delivery receipts" testSendDeliveryReceipts it "should send delivery receipts depending on configuration" testConfigureDeliveryReceipts + describe "negotiate connection chat protocol version range" $ do + describe "version range correctly set for new connection via invitation" $ do + testInvVRange supportedChatVRange supportedChatVRange + testInvVRange supportedChatVRange vr11 + testInvVRange vr11 supportedChatVRange + testInvVRange vr11 vr11 + describe "version range correctly set for new connection via contact request" $ do + testReqVRange supportedChatVRange supportedChatVRange + testReqVRange supportedChatVRange vr11 + testReqVRange vr11 supportedChatVRange + testReqVRange vr11 vr11 + it "update connection version range on received messages" testUpdateConnChatVRange + where + testInvVRange vr1 vr2 = it (vRangeStr vr1 <> " - " <> vRangeStr vr2) $ testConnInvChatVRange vr1 vr2 + testReqVRange vr1 vr2 = it (vRangeStr vr1 <> " - " <> vRangeStr vr2) $ testConnReqChatVRange vr1 vr2 testAddContact :: HasCallStack => SpecWith FilePath testAddContact = versionTestMatrix2 runTestAddContact @@ -1939,8 +1956,7 @@ testMarkContactVerified = testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob alice ##> "/i bob" - bobInfo alice - alice <## "connection not verified, use /code command to see security code" + bobInfo alice False alice ##> "/code bob" bCode <- getTermLine alice bob ##> "/code alice" @@ -1951,28 +1967,31 @@ testMarkContactVerified = alice ##> ("/verify bob " <> aCode) alice <## "connection verified" alice ##> "/i bob" - bobInfo alice - alice <## "connection verified" + bobInfo alice True alice ##> "/verify bob" alice <##. "connection not verified, current code is " alice ##> "/i bob" - bobInfo alice - alice <## "connection not verified, use /code command to see security code" + bobInfo alice False where - bobInfo :: HasCallStack => TestCC -> IO () - bobInfo alice = do + bobInfo :: HasCallStack => TestCC -> Bool -> IO () + bobInfo alice verified = do alice <## "contact ID: 2" alice <## "receiving messages via: localhost" alice <## "sending messages via: localhost" alice <## "you've shared main profile with this contact" + alice <## connVerified + alice <## currentChatVRangeInfo + where + connVerified + | verified = "connection verified" + | otherwise = "connection not verified, use /code command to see security code" testMarkGroupMemberVerified :: HasCallStack => FilePath -> IO () testMarkGroupMemberVerified = testChat2 aliceProfile bobProfile $ \alice bob -> do createGroup2 "team" alice bob alice ##> "/i #team bob" - bobInfo alice - alice <## "connection not verified, use /code command to see security code" + bobInfo alice False alice ##> "/code #team bob" bCode <- getTermLine alice bob ##> "/code #team alice" @@ -1983,20 +2002,24 @@ testMarkGroupMemberVerified = alice ##> ("/verify #team bob " <> aCode) alice <## "connection verified" alice ##> "/i #team bob" - bobInfo alice - alice <## "connection verified" + bobInfo alice True alice ##> "/verify #team bob" alice <##. "connection not verified, current code is " alice ##> "/i #team bob" - bobInfo alice - alice <## "connection not verified, use /code command to see security code" + bobInfo alice False where - bobInfo :: HasCallStack => TestCC -> IO () - bobInfo alice = do + bobInfo :: HasCallStack => TestCC -> Bool -> IO () + bobInfo alice verified = do alice <## "group ID: 1" alice <## "member ID: 2" alice <## "receiving messages via: localhost" alice <## "sending messages via: localhost" + alice <## connVerified + alice <## currentChatVRangeInfo + where + connVerified + | verified = "connection verified" + | otherwise = "connection not verified, use /code command to see security code" testMsgDecryptError :: HasCallStack => FilePath -> IO () testMsgDecryptError tmp = @@ -2088,8 +2111,7 @@ testSyncRatchetCodeReset tmp = alice <# "bob> hey" -- connection not verified bob ##> "/i alice" - aliceInfo bob - bob <## "connection not verified, use /code command to see security code" + aliceInfo bob False -- verify connection alice ##> "/code bob" bCode <- getTermLine alice @@ -2097,8 +2119,7 @@ testSyncRatchetCodeReset tmp = bob <## "connection verified" -- connection verified bob ##> "/i alice" - aliceInfo bob - bob <## "connection verified" + aliceInfo bob True setupDesynchronizedRatchet tmp alice withTestChat tmp "bob_old" $ \bob -> do bob <## "1 contacts connected (use /cs for the list)" @@ -2115,20 +2136,25 @@ testSyncRatchetCodeReset tmp = -- connection not verified bob ##> "/i alice" - aliceInfo bob - bob <## "connection not verified, use /code command to see security code" + aliceInfo bob False alice #> "@bob hello again" bob <# "alice> hello again" bob #> "@alice received!" alice <# "bob> received!" where - aliceInfo :: HasCallStack => TestCC -> IO () - aliceInfo bob = do + aliceInfo :: HasCallStack => TestCC -> Bool -> IO () + aliceInfo bob verified = do bob <## "contact ID: 2" bob <## "receiving messages via: localhost" bob <## "sending messages via: localhost" bob <## "you've shared main profile with this contact" + bob <## connVerified + bob <## currentChatVRangeInfo + where + connVerified + | verified = "connection verified" + | otherwise = "connection not verified, use /code command to see security code" testSetMessageReactions :: HasCallStack => FilePath -> IO () testSetMessageReactions = @@ -2271,3 +2297,85 @@ testConfigureDeliveryReceipts tmp = cc1 #> ("@" <> name2 <> " " <> msg) cc2 <# (name1 <> "> " <> msg) cc1 VersionRange -> VersionRange -> FilePath -> IO () +testConnInvChatVRange ct1VRange ct2VRange tmp = + withNewTestChatCfg tmp testCfg {chatVRange = ct1VRange} "alice" aliceProfile $ \alice -> do + withNewTestChatCfg tmp testCfg {chatVRange = ct2VRange} "bob" bobProfile $ \bob -> do + connectUsers alice bob + + alice ##> "/i bob" + contactInfoChatVRange alice ct2VRange + + bob ##> "/i alice" + contactInfoChatVRange bob ct1VRange + +testConnReqChatVRange :: HasCallStack => VersionRange -> VersionRange -> FilePath -> IO () +testConnReqChatVRange ct1VRange ct2VRange tmp = + withNewTestChatCfg tmp testCfg {chatVRange = ct1VRange} "alice" aliceProfile $ \alice -> do + withNewTestChatCfg tmp testCfg {chatVRange = ct2VRange} "bob" bobProfile $ \bob -> do + alice ##> "/ad" + cLink <- getContactLink alice True + bob ##> ("/c " <> cLink) + alice <#? bob + alice ##> "/ac bob" + alice <## "bob (Bob): accepting contact request..." + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob): contact is connected") + + alice ##> "/i bob" + contactInfoChatVRange alice ct2VRange + + bob ##> "/i alice" + contactInfoChatVRange bob ct1VRange + +testUpdateConnChatVRange :: HasCallStack => FilePath -> IO () +testUpdateConnChatVRange tmp = + withNewTestChat tmp "alice" aliceProfile $ \alice -> do + withNewTestChatCfg tmp cfg11 "bob" bobProfile $ \bob -> do + connectUsers alice bob + + alice ##> "/i bob" + contactInfoChatVRange alice vr11 + + bob ##> "/i alice" + contactInfoChatVRange bob supportedChatVRange + + withTestChat tmp "bob" $ \bob -> do + bob <## "1 contacts connected (use /cs for the list)" + + bob #> "@alice hello 1" + alice <# "bob> hello 1" + + alice ##> "/i bob" + contactInfoChatVRange alice supportedChatVRange + + bob ##> "/i alice" + contactInfoChatVRange bob supportedChatVRange + + withTestChatCfg tmp cfg11 "bob" $ \bob -> do + bob <## "1 contacts connected (use /cs for the list)" + + bob #> "@alice hello 2" + alice <# "bob> hello 2" + + alice ##> "/i bob" + contactInfoChatVRange alice vr11 + + bob ##> "/i alice" + contactInfoChatVRange bob supportedChatVRange + where + cfg11 = testCfg {chatVRange = vr11} :: ChatConfig + +vr11 :: VersionRange +vr11 = mkVersionRange 1 1 + +contactInfoChatVRange :: TestCC -> VersionRange -> IO () +contactInfoChatVRange cc (VersionRange minVer maxVer) = do + cc <## "contact ID: 2" + cc <## "receiving messages via: localhost" + cc <## "sending messages via: localhost" + cc <## "you've shared main profile with this contact" + cc <## "connection not verified, use /code command to see security code" + cc <## ("chat protocol version range: (" <> show minVer <> ", " <> show maxVer <> ")") diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 2f5b2689b..7a4bb2061 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -2289,8 +2289,7 @@ testGroupSyncRatchetCodeReset tmp = alice <# "#team bob> hey" -- connection not verified bob ##> "/i #team alice" - aliceInfo bob - bob <## "connection not verified, use /code command to see security code" + aliceInfo bob False -- verify connection alice ##> "/code #team bob" bCode <- getTermLine alice @@ -2298,8 +2297,7 @@ testGroupSyncRatchetCodeReset tmp = bob <## "connection verified" -- connection verified bob ##> "/i #team alice" - aliceInfo bob - bob <## "connection verified" + aliceInfo bob True setupDesynchronizedRatchet tmp alice withTestChat tmp "bob_old" $ \bob -> do bob <## "1 contacts connected (use /cs for the list)" @@ -2317,20 +2315,25 @@ testGroupSyncRatchetCodeReset tmp = -- connection not verified bob ##> "/i #team alice" - aliceInfo bob - bob <## "connection not verified, use /code command to see security code" + aliceInfo bob False alice #> "#team hello again" bob <# "#team alice> hello again" bob #> "#team received!" alice <# "#team bob> received!" where - aliceInfo :: HasCallStack => TestCC -> IO () - aliceInfo bob = do + aliceInfo :: HasCallStack => TestCC -> Bool -> IO () + aliceInfo bob verified = do bob <## "group ID: 1" bob <## "member ID: 1" bob <## "receiving messages via: localhost" bob <## "sending messages via: localhost" + bob <## connVerified + bob <## currentChatVRangeInfo + where + connVerified + | verified = "connection verified" + | otherwise = "connection not verified, use /code command to see security code" testSetGroupMessageReactions :: HasCallStack => FilePath -> IO () testSetGroupMessageReactions = diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 98c840388..c51202340 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -214,6 +214,7 @@ testProfileLink = cc <## ("contact address: " <> cLink) cc <## "you've shared main profile with this contact" cc <## "connection not verified, use /code command to see security code" + cc <## currentChatVRangeInfo checkAliceNoProfileLink cc = do cc ##> "/info alice" cc <## "contact ID: 2" @@ -221,6 +222,7 @@ testProfileLink = cc <##. "sending messages via" cc <## "you've shared main profile with this contact" cc <## "connection not verified, use /code command to see security code" + cc <## currentChatVRangeInfo testUserContactLinkAutoAccept :: HasCallStack => FilePath -> IO () testUserContactLinkAutoAccept = diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 4c7ca8d0a..b525bf333 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -18,11 +18,13 @@ import Data.Maybe (fromMaybe) import Data.String import qualified Data.Text as T import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), InlineFilesConfig (..), defaultInlineFilesConfig) +import Simplex.Chat.Protocol import Simplex.Chat.Store.Profiles (getUserContactProfiles) import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Messaging.Agent.Store.SQLite (withTransaction) import Simplex.Messaging.Encoding.String +import Simplex.Messaging.Version import System.Directory (doesFileExist) import System.Environment (lookupEnv) import System.FilePath (()) @@ -356,7 +358,7 @@ dropTime_ msg = case splitAt 6 msg of _ -> Nothing dropStrPrefix :: HasCallStack => String -> String -> String -dropStrPrefix pfx s = +dropStrPrefix pfx s = let (p, rest) = splitAt (length pfx) s in if p == pfx then rest else error $ "no prefix " <> pfx <> " in string : " <> s @@ -523,3 +525,10 @@ startFileTransferWithDest' cc1 cc2 fileName fileSize fileDest_ = do concurrently_ (cc2 <## ("started receiving file 1 (" <> fileName <> ") from " <> name1)) (cc1 <## ("started sending file 1 (" <> fileName <> ") to " <> name2)) + +currentChatVRangeInfo :: String +currentChatVRangeInfo = + "chat protocol version range: " <> vRangeStr supportedChatVRange + +vRangeStr :: VersionRange -> String +vRangeStr (VersionRange minVer maxVer) = "(" <> show minVer <> ", " <> show maxVer <> ")" diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index 6f7e0b8cf..98c592fa7 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -76,10 +76,10 @@ s ##==## msg = do s ==## msg (==#) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation -s ==# msg = s ==## ChatMessage Nothing msg +s ==# msg = s ==## ChatMessage chatInitialVRange Nothing msg (#==) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation -s #== msg = s ##== ChatMessage Nothing msg +s #== msg = s ##== ChatMessage chatInitialVRange Nothing msg (#==#) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation s #==# msg = do @@ -101,59 +101,66 @@ testGroupProfile = GroupProfile {displayName = "team", fullName = "Team", descri decodeChatMessageTest :: Spec decodeChatMessageTest = describe "Chat message encoding/decoding" $ do it "x.msg.new simple text" $ - "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" + "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" #==# XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)) it "x.msg.new simple text - timed message TTL" $ - "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"ttl\":3600}}" + "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"ttl\":3600}}" #==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing)) it "x.msg.new simple text - live message" $ - "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"live\":true}}" + "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"live\":true}}" #==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing Nothing (Just True))) it "x.msg.new simple link" $ - "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"link\",\"preview\":{\"description\":\"SimpleX Chat\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA\",\"title\":\"SimpleX Chat\",\"uri\":\"https://simplex.chat\"}}}}" + "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"link\",\"preview\":{\"description\":\"SimpleX Chat\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA\",\"title\":\"SimpleX Chat\",\"uri\":\"https://simplex.chat\"}}}}" #==# XMsgNew (MCSimple (extMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA", content = Nothing}) Nothing)) it "x.msg.new simple image" $ - "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" + "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" #==# XMsgNew (MCSimple (extMsgContent (MCImage "" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing)) it "x.msg.new simple image with text" $ - "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"here's an image\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" + "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"here's an image\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" #==# XMsgNew (MCSimple (extMsgContent (MCImage "here's an image" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing)) - it "x.msg.new chat message " $ - "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" - ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) + it "x.msg.new chat message" $ + "{\"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))) + it "x.msg.new chat message with chat version range" $ + "{\"v\":\"1-2\",\"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))) it "x.msg.new quote" $ - "{\"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\"}}}}" ##==## ChatMessage + chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCQuote quotedMsg (extMsgContent (MCText "hello to you too") Nothing))) it "x.msg.new quote - timed message TTL" $ - "{\"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\"}},\"ttl\":3600}}" + "{\"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\"}},\"ttl\":3600}}" ##==## ChatMessage + chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") Nothing (Just 3600) Nothing))) it "x.msg.new quote - live message" $ - "{\"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\"}},\"live\":true}}" + "{\"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\"}},\"live\":true}}" ##==## ChatMessage + chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") Nothing Nothing (Just True)))) it "x.msg.new forward" $ - "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true}}" - ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") Nothing)) + "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true}}" + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") Nothing)) it "x.msg.new forward - timed message TTL" $ - "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"ttl\":3600}}" - ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing)) + "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"ttl\":3600}}" + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing)) it "x.msg.new forward - live message" $ - "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"live\":true}}" - ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing Nothing (Just True))) + "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"live\":true}}" + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing Nothing (Just True))) it "x.msg.new simple text with file" $ - "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" + "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" #==# XMsgNew (MCSimple (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}))) it "x.msg.new simple file with file" $ - "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"file\"},\"file\":{\"fileSize\":12345,\"fileName\":\"file.txt\"}}}" + "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"file\"},\"file\":{\"fileSize\":12345,\"fileName\":\"file.txt\"}}}" #==# XMsgNew (MCSimple (extMsgContent (MCFile "") (Just FileInvitation {fileName = "file.txt", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}))) it "x.msg.new quote with file" $ - "{\"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\"}},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" + "{\"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\"}},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" ##==## ChatMessage + chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") ( XMsgNew ( MCQuote @@ -165,101 +172,101 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do ) ) it "x.msg.new forward with file" $ - "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" - ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}))) + "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" + ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}))) it "x.msg.update" $ - "{\"event\":\"x.msg.update\",\"params\":{\"msgId\":\"AQIDBA==\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" + "{\"v\":\"1\",\"event\":\"x.msg.update\",\"params\":{\"msgId\":\"AQIDBA==\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" #==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello") Nothing Nothing it "x.msg.del" $ - "{\"event\":\"x.msg.del\",\"params\":{\"msgId\":\"AQIDBA==\"}}" + "{\"v\":\"1\",\"event\":\"x.msg.del\",\"params\":{\"msgId\":\"AQIDBA==\"}}" #==# XMsgDel (SharedMsgId "\1\2\3\4") Nothing it "x.msg.deleted" $ - "{\"event\":\"x.msg.deleted\",\"params\":{}}" + "{\"v\":\"1\",\"event\":\"x.msg.deleted\",\"params\":{}}" #==# XMsgDeleted it "x.file" $ - "{\"event\":\"x.file\",\"params\":{\"file\":{\"fileConnReq\":\"https://simplex.chat/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\",\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" + "{\"v\":\"1\",\"event\":\"x.file\",\"params\":{\"file\":{\"fileConnReq\":\"https://simplex.chat/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\",\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" #==# XFile FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Just testConnReq, fileInline = Nothing, fileDescr = Nothing} it "x.file without file invitation" $ - "{\"event\":\"x.file\",\"params\":{\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" + "{\"v\":\"1\",\"event\":\"x.file\",\"params\":{\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" #==# XFile FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing} it "x.file.acpt" $ - "{\"event\":\"x.file.acpt\",\"params\":{\"fileName\":\"photo.jpg\"}}" + "{\"v\":\"1\",\"event\":\"x.file.acpt\",\"params\":{\"fileName\":\"photo.jpg\"}}" #==# XFileAcpt "photo.jpg" it "x.file.acpt.inv" $ - "{\"event\":\"x.file.acpt.inv\",\"params\":{\"msgId\":\"AQIDBA==\",\"fileName\":\"photo.jpg\",\"fileConnReq\":\"https://simplex.chat/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.file.acpt.inv\",\"params\":{\"msgId\":\"AQIDBA==\",\"fileName\":\"photo.jpg\",\"fileConnReq\":\"https://simplex.chat/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\"}}" #==# XFileAcptInv (SharedMsgId "\1\2\3\4") (Just testConnReq) "photo.jpg" it "x.file.acpt.inv" $ - "{\"event\":\"x.file.acpt.inv\",\"params\":{\"msgId\":\"AQIDBA==\",\"fileName\":\"photo.jpg\"}}" + "{\"v\":\"1\",\"event\":\"x.file.acpt.inv\",\"params\":{\"msgId\":\"AQIDBA==\",\"fileName\":\"photo.jpg\"}}" #==# XFileAcptInv (SharedMsgId "\1\2\3\4") Nothing "photo.jpg" it "x.file.cancel" $ - "{\"event\":\"x.file.cancel\",\"params\":{\"msgId\":\"AQIDBA==\"}}" + "{\"v\":\"1\",\"event\":\"x.file.cancel\",\"params\":{\"msgId\":\"AQIDBA==\"}}" #==# XFileCancel (SharedMsgId "\1\2\3\4") it "x.info" $ - "{\"event\":\"x.info\",\"params\":{\"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.info\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" #==# XInfo testProfile it "x.info with empty full name" $ - "{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"\",\"displayName\":\"alice\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" + "{\"v\":\"1\",\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"\",\"displayName\":\"alice\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" #==# XInfo Profile {displayName = "alice", fullName = "", image = Nothing, contactLink = Nothing, preferences = testChatPreferences} it "x.contact with xContactId" $ - "{\"event\":\"x.contact\",\"params\":{\"contactReqId\":\"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.contact\",\"params\":{\"contactReqId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" #==# XContact testProfile (Just $ XContactId "\1\2\3\4") it "x.contact without XContactId" $ - "{\"event\":\"x.contact\",\"params\":{\"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.contact\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" #==# XContact testProfile Nothing it "x.contact with content null" $ - "{\"event\":\"x.contact\",\"params\":{\"content\":null,\"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.contact\",\"params\":{\"content\":null,\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" ==# XContact testProfile Nothing it "x.contact with content (ignored)" $ - "{\"event\":\"x.contact\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"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.contact\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" ==# XContact testProfile Nothing it "x.grp.inv" $ - "{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/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\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}" + "{\"v\":\"1\",\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/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\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}" #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, groupLinkId = Nothing} it "x.grp.inv with group link id" $ - "{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/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\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}, \"groupLinkId\":\"AQIDBA==\"}}}" + "{\"v\":\"1\",\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/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\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}, \"groupLinkId\":\"AQIDBA==\"}}}" #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, groupLinkId = Just $ GroupLinkId "\1\2\3\4"} it "x.grp.acpt without incognito profile" $ - "{\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}" + "{\"v\":\"1\",\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpAcpt (MemberId "\1\2\3\4") it "x.grp.mem.new" $ - "{\"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, profile = testProfile} it "x.grp.mem.intro" $ - "{\"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, profile = testProfile} it "x.grp.mem.inv" $ - "{\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/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\":\"https://simplex.chat/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\":\"https://simplex.chat/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\":\"https://simplex.chat/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\"}}}" #==# XGrpMemInv (MemberId "\1\2\3\4") IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq} it "x.grp.mem.fwd" $ - "{\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/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\":\"https://simplex.chat/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\":\"https://simplex.chat/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\":\"https://simplex.chat/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, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq} it "x.grp.mem.info" $ - "{\"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\"}}}}}" #==# XGrpMemInfo (MemberId "\1\2\3\4") testProfile it "x.grp.mem.con" $ - "{\"event\":\"x.grp.mem.con\",\"params\":{\"memberId\":\"AQIDBA==\"}}" + "{\"v\":\"1\",\"event\":\"x.grp.mem.con\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpMemCon (MemberId "\1\2\3\4") it "x.grp.mem.con.all" $ - "{\"event\":\"x.grp.mem.con.all\",\"params\":{\"memberId\":\"AQIDBA==\"}}" + "{\"v\":\"1\",\"event\":\"x.grp.mem.con.all\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpMemConAll (MemberId "\1\2\3\4") it "x.grp.mem.del" $ - "{\"event\":\"x.grp.mem.del\",\"params\":{\"memberId\":\"AQIDBA==\"}}" + "{\"v\":\"1\",\"event\":\"x.grp.mem.del\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpMemDel (MemberId "\1\2\3\4") it "x.grp.leave" $ - "{\"event\":\"x.grp.leave\",\"params\":{}}" + "{\"v\":\"1\",\"event\":\"x.grp.leave\",\"params\":{}}" ==# XGrpLeave it "x.grp.del" $ - "{\"event\":\"x.grp.del\",\"params\":{}}" + "{\"v\":\"1\",\"event\":\"x.grp.del\",\"params\":{}}" ==# XGrpDel it "x.info.probe" $ - "{\"event\":\"x.info.probe\",\"params\":{\"probe\":\"AQIDBA==\"}}" + "{\"v\":\"1\",\"event\":\"x.info.probe\",\"params\":{\"probe\":\"AQIDBA==\"}}" #==# XInfoProbe (Probe "\1\2\3\4") it "x.info.probe.check" $ - "{\"event\":\"x.info.probe.check\",\"params\":{\"probeHash\":\"AQIDBA==\"}}" + "{\"v\":\"1\",\"event\":\"x.info.probe.check\",\"params\":{\"probeHash\":\"AQIDBA==\"}}" #==# XInfoProbeCheck (ProbeHash "\1\2\3\4") it "x.info.probe.ok" $ - "{\"event\":\"x.info.probe.ok\",\"params\":{\"probe\":\"AQIDBA==\"}}" + "{\"v\":\"1\",\"event\":\"x.info.probe.ok\",\"params\":{\"probe\":\"AQIDBA==\"}}" #==# XInfoProbeOk (Probe "\1\2\3\4") it "x.ok" $ - "{\"event\":\"x.ok\",\"params\":{}}" + "{\"v\":\"1\",\"event\":\"x.ok\",\"params\":{}}" ==# XOk