From a72f603e13b02c19fc40289bfb444050587c9b5e Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Tue, 1 Nov 2022 13:26:08 +0000 Subject: [PATCH] core: switch connection (#1277) * core: switch connection * chat items for SWITCH * additional events for connection switch * update simplexmq * test * comment test output * update messages for connection switch Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com> --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- simplex-chat.cabal | 1 - src/Simplex/Chat.hs | 77 +++++++++++++++++++----------- src/Simplex/Chat/Archive.hs | 2 +- src/Simplex/Chat/Call.hs | 2 +- src/Simplex/Chat/Controller.hs | 15 ++++++ src/Simplex/Chat/Messages.hs | 74 ++++++++++++++++++++++++++-- src/Simplex/Chat/Mobile.hs | 3 +- src/Simplex/Chat/Protocol.hs | 3 +- src/Simplex/Chat/Terminal/Input.hs | 2 +- src/Simplex/Chat/Types.hs | 9 ++++ src/Simplex/Chat/Util.hs | 10 ---- src/Simplex/Chat/View.hs | 34 ++++++++----- stack.yaml | 2 +- tests/ChatTests.hs | 34 +++++++++++++ tests/ProtocolTests.hs | 3 +- 17 files changed, 209 insertions(+), 66 deletions(-) delete mode 100644 src/Simplex/Chat/Util.hs diff --git a/cabal.project b/cabal.project index 8ca3b1244..4aa17e474 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 8d9816809f6f05fc13de047ee6662312977be5fc + tag: d9a0e78b04d2bdc79a197125b7cc104c309bdbd8 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 8e95b35fc..65bcb40e7 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."8d9816809f6f05fc13de047ee6662312977be5fc" = "066r29zpm82xqwfgqmm5yd880zvksaacp03krif4kspn87hd4qsq"; + "https://github.com/simplex-chat/simplexmq.git"."d9a0e78b04d2bdc79a197125b7cc104c309bdbd8" = "08g686fnzmimiqfv1lqjphafkvw858dip1awg137days5sb5rqsf"; "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd"; "https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0"; "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp"; diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 2ce2f4fd6..aa622a990 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -70,7 +70,6 @@ library Simplex.Chat.Terminal.Notification Simplex.Chat.Terminal.Output Simplex.Chat.Types - Simplex.Chat.Util Simplex.Chat.View other-modules: Paths_simplex_chat diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 00cf42c91..49f5b4706 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -55,7 +55,6 @@ import Simplex.Chat.ProfileGenerator (generateRandomProfile) import Simplex.Chat.Protocol import Simplex.Chat.Store import Simplex.Chat.Types -import Simplex.Chat.Util (safeDecodeUtf8) import Simplex.Messaging.Agent as Agent import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), AgentDatabase (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig) import Simplex.Messaging.Agent.Lock @@ -300,7 +299,7 @@ processChatCommand = \case (agentConnId_, fileConnReq) <- if isJust fileInline then pure (Nothing, Nothing) - else bimap Just Just <$> withAgent (\a -> createConnection a True SCMInvitation) + else bimap Just Just <$> withAgent (\a -> createConnection a True SCMInvitation Nothing) let fileName = takeFileName file fileInvitation = FileInvitation {fileName, fileSize, fileConnReq, fileInline} withStore' $ \db -> do @@ -718,6 +717,15 @@ processChatCommand = \case (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m) pure $ CRGroupMemberInfo g m connectionStats + APISwitchContact contactId -> withUser $ \User {userId} -> do + ct <- withStore $ \db -> getContact db userId contactId + withAgent $ \a -> switchConnectionAsync a "" $ contactConnId ct + pure CRCmdOk + APISwitchGroupMember gId gMemberId -> withUser $ \user -> do + m <- withStore $ \db -> getGroupMember db user gId gMemberId + case memberConnId m of + Just connId -> withAgent (\a -> switchConnectionAsync a "" connId) $> CRCmdOk + _ -> throwChatError CEGroupMemberNotActive ShowMessages (ChatName cType name) ntfOn -> withUser $ \user -> do chatId <- case cType of CTDirect -> withStore $ \db -> getContactIdByName db user name @@ -730,13 +738,19 @@ processChatCommand = \case GroupMemberInfo gName mName -> withUser $ \user -> do (gId, mId) <- withStore $ \db -> getGroupIdByName db user gName >>= \gId -> (gId,) <$> getGroupMemberIdByName db user gId mName processChatCommand $ APIGroupMemberInfo gId mId + SwitchContact cName -> withUser $ \user -> do + contactId <- withStore $ \db -> getContactIdByName db user cName + processChatCommand $ APISwitchContact contactId + SwitchGroupMember gName mName -> withUser $ \user -> do + (gId, mId) <- withStore $ \db -> getGroupIdByName db user gName >>= \gId -> (gId,) <$> getGroupMemberIdByName db user gId mName + processChatCommand $ APISwitchGroupMember gId mId ChatHelp section -> pure $ CRChatHelp section Welcome -> withUser $ pure . CRWelcome AddContact -> withUser $ \User {userId} -> withChatLock "addContact" . procCmd $ do -- [incognito] generate profile for connection incognito <- readTVarIO =<< asks incognitoMode incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing - (connId, cReq) <- withAgent $ \a -> createConnection a True SCMInvitation + (connId, cReq) <- withAgent $ \a -> createConnection a True SCMInvitation Nothing conn <- withStore' $ \db -> createDirectConnection db userId connId cReq ConnNew incognitoProfile toView $ CRNewContactConnection conn pure $ CRInvitation cReq @@ -764,7 +778,7 @@ processChatCommand = \case processChatCommand $ APIClearChat (ChatRef CTDirect contactId) ListContacts -> withUser $ \user -> CRContactsList <$> withStore' (`getUserContacts` user) CreateMyAddress -> withUser $ \User {userId} -> withChatLock "createMyAddress" . procCmd $ do - (connId, cReq) <- withAgent $ \a -> createConnection a True SCMContact + (connId, cReq) <- withAgent $ \a -> createConnection a True SCMContact Nothing withStore $ \db -> createUserContactLink db userId connId cReq pure $ CRUserContactLinkCreated cReq DeleteMyAddress -> withUser $ \user -> withChatLock "deleteMyAddress" $ do @@ -835,7 +849,7 @@ processChatCommand = \case case contactMember contact members of Nothing -> do gVar <- asks idsDrg - (agentConnId, cReq) <- withAgent $ \a -> createConnection a True SCMInvitation + (agentConnId, cReq) <- withAgent $ \a -> createConnection a True SCMInvitation Nothing member <- withStore $ \db -> createNewContactMember db gVar user groupId contact memRole agentConnId cReq sendInvitation member cReq pure $ CRSentGroupInvitation gInfo contact member @@ -969,7 +983,7 @@ processChatCommand = \case when (userRole < GRAdmin) $ throwChatError CEGroupUserRole when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined gInfo) unless (memberActive membership) $ throwChatError CEGroupMemberNotActive - (connId, cReq) <- withAgent $ \a -> createConnection a True SCMContact + (connId, cReq) <- withAgent $ \a -> createConnection a True SCMContact Nothing withStore $ \db -> createGroupLink db user gInfo connId cReq pure $ CRGroupLinkCreated gInfo cReq APIDeleteGroupLink groupId -> withUser $ \user -> withChatLock "deleteGroupLink" $ do @@ -1303,7 +1317,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = F | fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName | otherwise -> do -- accepting via a new connection - (agentConnId, fileInvConnReq) <- withAgent $ \a -> createConnection a True SCMInvitation + (agentConnId, fileInvConnReq) <- withAgent $ \a -> createConnection a True SCMInvitation Nothing ci <- withStore $ \db -> acceptRcvFileTransfer db user fileId agentConnId ConnNew filePath pure (XFileAcptInv sharedMsgId (Just fileInvConnReq) fName, ci) receiveInline :: m Bool @@ -1725,6 +1739,11 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM chatItem <- withStore $ \db -> updateDirectChatItemStatus db userId contactId (chatItemId' ci) CISSndSent toView $ CRChatItemStatusUpdated (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem) _ -> pure () + SWITCH qd phase cStats -> do + toView . CRContactSwitch ct $ SwitchProgress qd phase cStats + when (phase /= SPConfirmed) $ case qd of + QDRcv -> createInternalChatItem (CDDirectSnd ct) (CISndConnEvent $ SCESwitch phase Nothing) Nothing + QDSnd -> createInternalChatItem (CDDirectRcv ct) (CIRcvConnEvent $ RCESwitch phase) Nothing OK -> -- [async agent commands] continuation on receiving OK withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} -> @@ -1768,13 +1787,8 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM let GroupMember {memberRole = userRole, memberId = userMemberId} = membership groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile (_msg, _) <- sendDirectContactMessage ct $ XGrpInv groupInv - createdAt <- liftIO getCurrentTime - let content = CIRcvGroupEvent RGEInvitedViaGroupLink - cd = CDGroupRcv gInfo m -- we could link chat item with sent group invitation message (_msg) - ciId <- withStore' $ \db -> createNewChatItemNoMsg db user cd content createdAt createdAt - ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing createdAt createdAt - toView $ CRNewChatItem $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci + createInternalChatItem (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing _ -> throwChatError $ CECommandError "unexpected cmdFunction" CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" CONF confId _ connInfo -> do @@ -1872,6 +1886,11 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM SENT msgId -> do sentMsgDeliveryEvent conn msgId checkSndInlineFTComplete conn msgId + SWITCH qd phase cStats -> do + toView . CRGroupMemberSwitch gInfo m $ SwitchProgress qd phase cStats + when (phase /= SPConfirmed) $ case qd of + QDRcv -> createInternalChatItem (CDGroupSnd gInfo) (CISndConnEvent . SCESwitch phase . Just $ groupMemberRef m) Nothing + QDSnd -> createInternalChatItem (CDGroupRcv gInfo m) (CIRcvConnEvent $ RCESwitch phase) Nothing OK -> -- [async agent commands] continuation on receiving OK withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} -> @@ -2087,14 +2106,9 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM throwChatError $ CEFileRcvChunk err memberConnectedChatItem :: GroupInfo -> GroupMember -> m () - memberConnectedChatItem gInfo m = do - createdAt <- liftIO getCurrentTime - let content = CIRcvGroupEvent RGEMemberConnected - cd = CDGroupRcv gInfo m - -- first ts should be broker ts but we don't have it for CON - ciId <- withStore' $ \db -> createNewChatItemNoMsg db user cd content createdAt createdAt - ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing createdAt createdAt - toView $ CRNewChatItem $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci + memberConnectedChatItem gInfo m = + -- ts should be broker ts but we don't have it for CON + createInternalChatItem (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEMemberConnected) Nothing notifyMemberConnected :: GroupInfo -> GroupMember -> m () notifyMemberConnected gInfo m@GroupMember {localDisplayName = c} = do @@ -2401,15 +2415,16 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM checkIntegrityCreateItem cd MsgMeta {integrity, broker = (_, brokerTs)} = case integrity of MsgOk -> pure () MsgError e -> case e of - MsgSkipped {} -> createIntegrityErrorItem e + MsgSkipped {} -> createInternalChatItem cd (CIRcvIntegrityError e) (Just brokerTs) _ -> toView $ CRMsgIntegrityError e - where - createIntegrityErrorItem e = do - createdAt <- liftIO getCurrentTime - let content = CIRcvIntegrityError e - ciId <- withStore' $ \db -> createNewChatItemNoMsg db user cd content brokerTs createdAt - ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing brokerTs createdAt - toView $ CRNewChatItem $ AChatItem (chatTypeI @c) SMDRcv (toChatInfo cd) ci + + createInternalChatItem :: forall c d. (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> CIContent d -> Maybe UTCTime -> m () + createInternalChatItem cd content itemTs_ = do + createdAt <- liftIO getCurrentTime + let itemTs = fromMaybe createdAt itemTs_ + ciId <- withStore' $ \db -> createNewChatItemNoMsg db user cd content itemTs createdAt + ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing itemTs createdAt + toView $ CRNewChatItem $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci xInfo :: Contact -> Profile -> m () xInfo c@Contact {profile = p} p' = unless (fromLocalProfile p == p') $ do @@ -3151,6 +3166,10 @@ chatCommandP = "/_info @" *> (APIContactInfo <$> A.decimal), ("/info #" <|> "/i #") *> (GroupMemberInfo <$> displayName <* A.space <* optional (A.char '@') <*> displayName), ("/info @" <|> "/info " <|> "/i @" <|> "/i ") *> (ContactInfo <$> displayName), + "/_switch #" *> (APISwitchGroupMember <$> A.decimal <* A.space <*> A.decimal), + "/_switch @" *> (APISwitchContact <$> A.decimal), + "/switch #" *> (SwitchGroupMember <$> displayName <* A.space <* optional (A.char '@') <*> displayName), + ("/switch @" <|> "/switch ") *> (SwitchContact <$> displayName), ("/help files" <|> "/help file" <|> "/hf") $> ChatHelp HSFiles, ("/help groups" <|> "/help group" <|> "/hg") $> ChatHelp HSGroups, ("/help address" <|> "/ha") $> ChatHelp HSMyAddress, diff --git a/src/Simplex/Chat/Archive.hs b/src/Simplex/Chat/Archive.hs index 9939bf957..f07fba4ca 100644 --- a/src/Simplex/Chat/Archive.hs +++ b/src/Simplex/Chat/Archive.hs @@ -21,7 +21,7 @@ import qualified Database.SQLite3 as SQL import Simplex.Chat.Controller import Simplex.Messaging.Agent.Client (agentClientStore) import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), sqlString) -import Simplex.Messaging.Util (unlessM, whenM) +import Simplex.Messaging.Util import System.FilePath import UnliftIO.Directory import UnliftIO.Exception (SomeException, bracket, catch) diff --git a/src/Simplex/Chat/Call.hs b/src/Simplex/Chat/Call.hs index df73ad8d0..784d602ed 100644 --- a/src/Simplex/Chat/Call.hs +++ b/src/Simplex/Chat/Call.hs @@ -24,7 +24,7 @@ import Database.SQLite.Simple.FromField (FromField (..)) import Database.SQLite.Simple.ToField (ToField (..)) import GHC.Generics (Generic) import Simplex.Chat.Types (Contact, ContactId) -import Simplex.Chat.Util (safeDecodeUtf8) +import Simplex.Messaging.Util (safeDecodeUtf8) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 76546f8ad..554e3da36 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -193,9 +193,13 @@ data ChatCommand | APISetChatSettings ChatRef ChatSettings | APIContactInfo ContactId | APIGroupMemberInfo GroupId GroupMemberId + | APISwitchContact ContactId + | APISwitchGroupMember GroupId GroupMemberId | ShowMessages ChatName Bool | ContactInfo ContactName | GroupMemberInfo GroupName ContactName + | SwitchContact ContactName + | SwitchGroupMember GroupName ContactName | ChatHelp HelpSection | Welcome | AddContact @@ -261,6 +265,8 @@ data ChatResponse | CRNetworkConfig {networkConfig :: NetworkConfig} | CRContactInfo {contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile} | CRGroupMemberInfo {groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats} + | CRContactSwitch {contact :: Contact, switchProgress :: SwitchProgress} + | CRGroupMemberSwitch {groupInfo :: GroupInfo, member :: GroupMember, switchProgress :: SwitchProgress} | CRNewChatItem {chatItem :: AChatItem} | CRChatItemStatusUpdated {chatItem :: AChatItem} | CRChatItemUpdated {chatItem :: AChatItem} @@ -448,6 +454,15 @@ instance ToJSON NtfMsgInfo where toEncoding = J.genericToEncoding J.defaultOptio crNtfToken :: (DeviceToken, NtfTknStatus, NotificationsMode) -> ChatResponse crNtfToken (token, status, ntfMode) = CRNtfToken {token, status, ntfMode} +data SwitchProgress = SwitchProgress + { queueDirection :: QueueDirection, + switchPhase :: SwitchPhase, + connectionStats :: ConnectionStats + } + deriving (Show, Generic) + +instance ToJSON SwitchProgress where toEncoding = J.genericToEncoding J.defaultOptions + data ChatError = ChatError {errorType :: ChatErrorType} | ChatErrorAgent {agentError :: AgentErrorType} diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index ff67c5704..f63e7765c 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -32,12 +32,11 @@ import GHC.Generics (Generic) import Simplex.Chat.Markdown import Simplex.Chat.Protocol import Simplex.Chat.Types -import Simplex.Chat.Util (safeDecodeUtf8) -import Simplex.Messaging.Agent.Protocol (AgentErrorType, AgentMsgId, MsgErrorType (..), MsgMeta (..)) +import Simplex.Messaging.Agent.Protocol (SwitchPhase (..), AgentErrorType, AgentMsgId, MsgErrorType (..), MsgMeta (..), SwitchPhase) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON, sumTypeJSON) import Simplex.Messaging.Protocol (MsgBody) -import Simplex.Messaging.Util (eitherToMaybe, (<$?>)) +import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection deriving (Show, Generic) @@ -524,6 +523,21 @@ sndGroupEventToText = \case SGEUserLeft -> "left" SGEGroupUpdated _ -> "group profile updated" +rcvConnEventToText :: RcvConnEvent -> Text +rcvConnEventToText = \case + RCESwitch phase -> case phase of + SPCompleted -> "changed address for you" + _ -> decodeLatin1 (strEncode phase) <> " changing address for you..." + +sndConnEventToText :: SndConnEvent -> Text +sndConnEventToText = \case + SCESwitch phase m -> case phase of + SPCompleted -> "you changed address" <> forMember m + _ -> decodeLatin1 (strEncode phase) <> " changing address" <> forMember m <> "..." + where + forMember member_ = + maybe "" (\GroupMemberRef {profile = Profile {displayName}} -> " for " <> displayName) member_ + profileToText :: Profile -> Text profileToText Profile {displayName, fullName} = displayName <> optionalFullName displayName fullName @@ -542,6 +556,8 @@ data CIContent (d :: MsgDirection) where CISndGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDSnd CIRcvGroupEvent :: RcvGroupEvent -> CIContent 'MDRcv CISndGroupEvent :: SndGroupEvent -> CIContent 'MDSnd + CIRcvConnEvent :: RcvConnEvent -> CIContent 'MDRcv + CISndConnEvent :: SndConnEvent -> CIContent 'MDSnd -- ^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API -- ! ^ Nested sum types also have to use different encodings for database and API -- ! ^ to avoid breaking cross-platform compatibility, see RcvGroupEvent and SndGroupEvent @@ -604,6 +620,44 @@ instance ToJSON DBSndGroupEvent where toJSON (SGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SGE") v toEncoding (SGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SGE") v +data RcvConnEvent = RCESwitch {phase :: SwitchPhase} + deriving (Show, Generic) + +data SndConnEvent = SCESwitch {phase :: SwitchPhase, member :: Maybe GroupMemberRef} + deriving (Show, Generic) + +instance FromJSON RcvConnEvent where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RCE" + +instance ToJSON RcvConnEvent where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RCE" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RCE" + +newtype DBRcvConnEvent = RCE RcvConnEvent + +instance FromJSON DBRcvConnEvent where + parseJSON v = RCE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RCE") v + +instance ToJSON DBRcvConnEvent where + toJSON (RCE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RCE") v + toEncoding (RCE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RCE") v + +instance FromJSON SndConnEvent where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SCE" + +instance ToJSON SndConnEvent where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SCE" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SCE" + +newtype DBSndConnEvent = SCE SndConnEvent + +instance FromJSON DBSndConnEvent where + parseJSON v = SCE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "SCE") v + +instance ToJSON DBSndConnEvent where + toJSON (SCE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SCE") v + toEncoding (SCE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SCE") v + newtype DBMsgErrorType = DBME MsgErrorType instance FromJSON DBMsgErrorType where @@ -653,6 +707,8 @@ ciContentToText = \case CISndGroupInvitation groupInvitation memberRole -> "sent " <> ciGroupInvitationToText groupInvitation memberRole CIRcvGroupEvent event -> rcvGroupEventToText event CISndGroupEvent event -> sndGroupEventToText event + CIRcvConnEvent event -> rcvConnEventToText event + CISndConnEvent event -> sndConnEventToText event msgIntegrityError :: MsgErrorType -> Text msgIntegrityError = \case @@ -701,6 +757,8 @@ data JSONCIContent | JCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} | JCIRcvGroupEvent {rcvGroupEvent :: RcvGroupEvent} | JCISndGroupEvent {sndGroupEvent :: SndGroupEvent} + | JCIRcvConnEvent {rcvConnEvent :: RcvConnEvent} + | JCISndConnEvent {sndConnEvent :: SndConnEvent} deriving (Generic) instance FromJSON JSONCIContent where @@ -723,6 +781,8 @@ jsonCIContent = \case CISndGroupInvitation groupInvitation memberRole -> JCISndGroupInvitation {groupInvitation, memberRole} CIRcvGroupEvent rcvGroupEvent -> JCIRcvGroupEvent {rcvGroupEvent} CISndGroupEvent sndGroupEvent -> JCISndGroupEvent {sndGroupEvent} + CIRcvConnEvent rcvConnEvent -> JCIRcvConnEvent {rcvConnEvent} + CISndConnEvent sndConnEvent -> JCISndConnEvent {sndConnEvent} aciContentJSON :: JSONCIContent -> ACIContent aciContentJSON = \case @@ -737,6 +797,8 @@ aciContentJSON = \case JCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole JCIRcvGroupEvent {rcvGroupEvent} -> ACIContent SMDRcv $ CIRcvGroupEvent rcvGroupEvent JCISndGroupEvent {sndGroupEvent} -> ACIContent SMDSnd $ CISndGroupEvent sndGroupEvent + JCIRcvConnEvent {rcvConnEvent} -> ACIContent SMDRcv $ CIRcvConnEvent rcvConnEvent + JCISndConnEvent {sndConnEvent} -> ACIContent SMDSnd $ CISndConnEvent sndConnEvent -- platform independent data DBJSONCIContent @@ -751,6 +813,8 @@ data DBJSONCIContent | DBJCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} | DBJCIRcvGroupEvent {rcvGroupEvent :: DBRcvGroupEvent} | DBJCISndGroupEvent {sndGroupEvent :: DBSndGroupEvent} + | DBJCIRcvConnEvent {rcvConnEvent :: DBRcvConnEvent} + | DBJCISndConnEvent {sndConnEvent :: DBSndConnEvent} deriving (Generic) instance FromJSON DBJSONCIContent where @@ -773,6 +837,8 @@ dbJsonCIContent = \case CISndGroupInvitation groupInvitation memberRole -> DBJCISndGroupInvitation {groupInvitation, memberRole} CIRcvGroupEvent rge -> DBJCIRcvGroupEvent $ RGE rge CISndGroupEvent sge -> DBJCISndGroupEvent $ SGE sge + CIRcvConnEvent rce -> DBJCIRcvConnEvent $ RCE rce + CISndConnEvent sce -> DBJCISndConnEvent $ SCE sce aciContentDBJSON :: DBJSONCIContent -> ACIContent aciContentDBJSON = \case @@ -787,6 +853,8 @@ aciContentDBJSON = \case DBJCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole DBJCIRcvGroupEvent (RGE rge) -> ACIContent SMDRcv $ CIRcvGroupEvent rge DBJCISndGroupEvent (SGE sge) -> ACIContent SMDSnd $ CISndGroupEvent sge + DBJCIRcvConnEvent (RCE rce) -> ACIContent SMDRcv $ CIRcvConnEvent rce + DBJCISndConnEvent (SCE sce) -> ACIContent SMDSnd $ CISndConnEvent sce data CICallStatus = CISCallPending diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index c33b5a92a..ebe92278d 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -31,13 +31,12 @@ import Simplex.Chat.Markdown (ParsedMarkdown (..), parseMaybeMarkdownList) import Simplex.Chat.Options import Simplex.Chat.Store import Simplex.Chat.Types -import Simplex.Chat.Util (safeDecodeUtf8) import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (yesToMigrations), createAgentStore) import Simplex.Messaging.Agent.Store.SQLite (closeSQLiteStore) import Simplex.Messaging.Client (defaultNetworkConfig) import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) import Simplex.Messaging.Protocol (CorrId (..)) -import Simplex.Messaging.Util (catchAll) +import Simplex.Messaging.Util (catchAll, safeDecodeUtf8) import System.Timeout (timeout) foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 6874d18bd..157acf30d 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -39,11 +39,10 @@ import Database.SQLite.Simple.ToField (ToField (..)) import GHC.Generics (Generic) import Simplex.Chat.Call import Simplex.Chat.Types -import Simplex.Chat.Util (safeDecodeUtf8) import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (fromTextField_, fstToLower, parseAll, sumTypeJSON) -import Simplex.Messaging.Util (eitherToMaybe, (<$?>)) +import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) data ConnectionEntity = RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact} diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index e186cf69b..d0daad9e4 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -16,8 +16,8 @@ import Simplex.Chat import Simplex.Chat.Controller import Simplex.Chat.Styled import Simplex.Chat.Terminal.Output -import Simplex.Chat.Util (safeDecodeUtf8) import Simplex.Chat.View +import Simplex.Messaging.Util (safeDecodeUtf8) import System.Exit (exitSuccess) import System.Terminal hiding (insertChars) import UnliftIO.STM diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 02422af56..d7078ae06 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -367,6 +367,15 @@ instance ToJSON GroupMember where toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} +data GroupMemberRef = GroupMemberRef {groupMemberId :: Int64, profile :: Profile} + deriving (Eq, Show, Generic, FromJSON) + +instance ToJSON GroupMemberRef where toEncoding = J.genericToEncoding J.defaultOptions + +groupMemberRef :: GroupMember -> GroupMemberRef +groupMemberRef GroupMember {groupMemberId, memberProfile = p} = + GroupMemberRef {groupMemberId, profile = fromLocalProfile p} + memberConn :: GroupMember -> Maybe Connection memberConn = activeConn diff --git a/src/Simplex/Chat/Util.hs b/src/Simplex/Chat/Util.hs deleted file mode 100644 index d2fe0c3d4..000000000 --- a/src/Simplex/Chat/Util.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Simplex.Chat.Util where - -import Data.ByteString.Char8 (ByteString) -import Data.Text (Text) -import Data.Text.Encoding (decodeUtf8With) - -safeDecodeUtf8 :: ByteString -> Text -safeDecodeUtf8 = decodeUtf8With onError - where - onError _ _ = Just '?' diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 98ae3f142..72998a5a8 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -67,6 +67,8 @@ responseToView testView = \case CRNetworkConfig cfg -> viewNetworkConfig cfg CRContactInfo ct cStats customUserProfile -> viewContactInfo ct cStats customUserProfile CRGroupMemberInfo g m cStats -> viewGroupMemberInfo g m cStats + CRContactSwitch ct progress -> viewContactSwitch ct progress + CRGroupMemberSwitch g m progress -> viewGroupMemberSwitch g m progress CRNewChatItem (AChatItem _ _ chat item) -> unmuted chat item $ viewChatItem chat item False CRLastMessages chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True) chatItems CRChatItemStatusUpdated _ -> [] @@ -254,19 +256,15 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow = c DirectChat c -> case chatDir of CIDirectSnd -> case content of CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc - CISndDeleted _ -> showSndItem to - CISndCall {} -> showSndItem to - CISndGroupInvitation {} -> showSndItem to CISndGroupEvent {} -> showSndItemProhibited to + _ -> showSndItem to where to = ttyToContact' c CIDirectRcv -> case content of CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc - CIRcvDeleted _ -> showRcvItem from - CIRcvCall {} -> showRcvItem from CIRcvIntegrityError err -> viewRcvIntegrityError from err meta - CIRcvGroupInvitation {} -> showRcvItem from CIRcvGroupEvent {} -> showRcvItemProhibited from + _ -> showRcvItem from where from = ttyFromContact' c where @@ -274,19 +272,15 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow = c GroupChat g -> case chatDir of CIGroupSnd -> case content of CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc - CISndDeleted _ -> showSndItem to - CISndCall {} -> showSndItem to CISndGroupInvitation {} -> showSndItemProhibited to - CISndGroupEvent {} -> showSndItem to + _ -> showSndItem to where to = ttyToGroup g CIGroupRcv m -> case content of CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc - CIRcvDeleted _ -> showRcvItem from - CIRcvCall {} -> showRcvItem from CIRcvIntegrityError err -> viewRcvIntegrityError from err meta CIRcvGroupInvitation {} -> showRcvItemProhibited from - CIRcvGroupEvent {} -> showRcvItem from + _ -> showRcvItem from where from = ttyFromGroup' g m where @@ -682,6 +676,22 @@ viewServers = plain . intercalate ", " . map (B.unpack . strEncode) viewServerHosts :: [SMPServer] -> StyledString viewServerHosts = plain . intercalate ", " . map showSMPServer +viewContactSwitch :: Contact -> SwitchProgress -> [StyledString] +viewContactSwitch _ (SwitchProgress _ SPConfirmed _) = [] +viewContactSwitch ct (SwitchProgress qd phase _) = case qd of + QDRcv -> [ttyContact' ct <> ": you " <> viewSwitchPhase phase] + QDSnd -> [ttyContact' ct <> " " <> viewSwitchPhase phase <> " for you"] + +viewGroupMemberSwitch :: GroupInfo -> GroupMember -> SwitchProgress -> [StyledString] +viewGroupMemberSwitch _ _ (SwitchProgress _ SPConfirmed _) = [] +viewGroupMemberSwitch g m (SwitchProgress qd phase _) = case qd of + QDRcv -> [ttyGroup' g <> ": you " <> viewSwitchPhase phase <> " for " <> ttyMember m] + QDSnd -> [ttyGroup' g <> ": " <> ttyMember m <> " " <> viewSwitchPhase phase <> " for you"] + +viewSwitchPhase :: SwitchPhase -> StyledString +viewSwitchPhase SPCompleted = "changed address" +viewSwitchPhase phase = plain (strEncode phase) <> " changing address" + viewUserProfileUpdated :: Profile -> Profile -> [StyledString] viewUserProfileUpdated Profile {displayName = n, fullName, image} Profile {displayName = n', fullName = fullName', image = image'} | n == n' && fullName == fullName' && image == image' = [] diff --git a/stack.yaml b/stack.yaml index 1853cd520..f0b28e81d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,7 +49,7 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: 8d9816809f6f05fc13de047ee6662312977be5fc + commit: d9a0e78b04d2bdc79a197125b7cc104c309bdbd8 # - ../direct-sqlcipher - github: simplex-chat/direct-sqlcipher commit: 34309410eb2069b029b8fc1872deb1e0db123294 diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 04dc18758..5310986f5 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -141,6 +141,9 @@ chatTests = do it "sending message to contact created via group link marks it used" testGroupLinkContactUsed it "create group link, join via group link - incognito membership" testGroupLinkIncognitoMembership it "deleting invited member does not leave broken chat item" testGroupLinkDeleteInvitedMemberNoBrokenItem + describe "queue rotation" $ do + it "switch contact to a different queue" testSwitchContact + it "switch group member to a different queue" testSwitchGroupMember versionTestMatrix2 :: (TestCC -> TestCC -> IO ()) -> Spec versionTestMatrix2 runTest = do @@ -3629,6 +3632,37 @@ testGroupLinkDeleteInvitedMemberNoBrokenItem = bob #> "#team_1 hi there" alice <# "#team bob> hi there" +testSwitchContact :: IO () +testSwitchContact = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + alice #$> ("/switch bob", id, "ok") + bob <## "alice started changing address for you" + alice <## "bob: you started changing address" + bob <## "alice changed address for you" + alice <## "bob: you changed address" + alice #$> ("/_get chat @2 count=100", chat, [(1, "started changing address..."), (1, "you changed address")]) + bob #$> ("/_get chat @2 count=100", chat, [(0, "started changing address for you..."), (0, "changed address for you")]) + alice <##> bob + +testSwitchGroupMember :: IO () +testSwitchGroupMember = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + createGroup2 "team" alice bob + alice #$> ("/switch #team bob", id, "ok") + bob <## "#team: alice started changing address for you" + alice <## "#team: you started changing address for bob" + bob <## "#team: alice changed address for you" + alice <## "#team: you changed address for bob" + alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "started changing address for bob..."), (1, "you changed address for bob")]) + bob #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (0, "started changing address for you..."), (0, "changed address for you")]) + alice #> "#team hey" + bob <# "#team alice> hey" + bob #> "#team hi" + alice <# "#team bob> hi" + withTestChatContactConnected :: String -> (TestCC -> IO a) -> IO a withTestChatContactConnected dbPrefix action = withTestChat dbPrefix $ \cc -> do diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index 785207b22..5c5b4eed7 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -40,7 +40,8 @@ connReqData = ConnReqUriData { crScheme = simplexChat, crAgentVRange = mkVersionRange 1 1, - crSmpQueues = [queue] + crSmpQueues = [queue], + crClientData = Nothing } testDhPubKey :: C.PublicKeyX448