dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-08-28 07:34:16 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: incognito connections (#926)

Browse Source
This commit is contained in:
JRoberts
2022-08-18 11:35:31 +04:00
committed by GitHub
parent 404b7093b7
commit 5e67654249
19 changed files with 4408 additions and 460 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+177 -97
View File
@@ -31,13 +31,12 @@ import Data.Either (fromRight)
import Data.Fixed (div')
import Data.Functor (($>))
import Data.Int (Int64)
import Data.List (find, isSuffixOf, sortBy, sortOn)
import Data.List (find, isSuffixOf, sortOn)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
import Data.Ord (comparing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds)
@@ -51,6 +50,7 @@ import Simplex.Chat.Controller
import Simplex.Chat.Markdown
import Simplex.Chat.Messages
import Simplex.Chat.Options
import Simplex.Chat.ProfileGenerator (generateRandomProfile)
import Simplex.Chat.Protocol
import Simplex.Chat.Store
import Simplex.Chat.Types
@@ -143,8 +143,9 @@ newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize, de
rcvFiles <- newTVarIO M.empty
currentCalls <- atomically TM.empty
filesFolder <- newTVarIO Nothing
incognitoMode <- newTVarIO False
chatStoreChanged <- newTVarIO False
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder}
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder}
where
resolveServers :: InitialAgentServers -> IO InitialAgentServers
resolveServers ss@InitialAgentServers {smp = defaultSMPServers} = case nonEmpty smpServers of
@@ -233,6 +234,10 @@ processChatCommand = \case
ff <- asks filesFolder
atomically . writeTVar ff $ Just filesFolder'
pure CRCmdOk
SetIncognito onOff -> do
incognito <- asks incognitoMode
atomically . writeTVar incognito $ onOff
pure CRCmdOk
APIExportArchive cfg -> checkChatStopped $ exportArchive cfg $> CRCmdOk
APIImportArchive cfg -> checkChatStopped $ importArchive cfg >> setStoreChanged $> CRCmdOk
APIDeleteStorage -> checkChatStopped $ deleteStorage >> setStoreChanged $> CRCmdOk
@@ -254,16 +259,14 @@ processChatCommand = \case
pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
where
setupSndFileTransfer :: Contact -> m (Maybe (FileInvitation, CIFile 'MDSnd))
setupSndFileTransfer ct = case file_ of
Nothing -> pure Nothing
Just file -> do
(fileSize, chSize) <- checkSndFile file
(agentConnId, fileConnReq) <- withAgent (`createConnection` SCMInvitation)
let fileName = takeFileName file
fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Just fileConnReq}
fileId <- withStore' $ \db -> createSndFileTransfer db userId ct file fileInvitation agentConnId chSize
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored}
pure $ Just (fileInvitation, ciFile)
setupSndFileTransfer ct = forM file_ $ \file -> do
(fileSize, chSize) <- checkSndFile file
(agentConnId, fileConnReq) <- withAgent (`createConnection` SCMInvitation)
let fileName = takeFileName file
fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Just fileConnReq}
fileId <- withStore' $ \db -> createSndFileTransfer db userId ct file fileInvitation agentConnId chSize
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored}
pure (fileInvitation, ciFile)
prepareMsg :: Maybe FileInvitation -> m (MsgContainer, Maybe (CIQuote 'CTDirect))
prepareMsg fileInvitation_ = case quotedItemId_ of
Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_), Nothing)
@@ -291,15 +294,13 @@ processChatCommand = \case
pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
where
setupSndFileTransfer :: GroupInfo -> m (Maybe (FileInvitation, CIFile 'MDSnd))
setupSndFileTransfer gInfo = case file_ of
Nothing -> pure Nothing
Just file -> do
(fileSize, chSize) <- checkSndFile file
let fileName = takeFileName file
fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Nothing}
fileId <- withStore' $ \db -> createSndGroupFileTransfer db userId gInfo file fileInvitation chSize
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored}
pure $ Just (fileInvitation, ciFile)
setupSndFileTransfer gInfo = forM file_ $ \file -> do
(fileSize, chSize) <- checkSndFile file
let fileName = takeFileName file
fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Nothing}
fileId <- withStore' $ \db -> createSndGroupFileTransfer db userId gInfo file fileInvitation chSize
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored}
pure (fileInvitation, ciFile)
prepareMsg :: Maybe FileInvitation -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
prepareMsg fileInvitation_ membership = case quotedItemId_ of
Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_), Nothing)
@@ -597,11 +598,17 @@ processChatCommand = \case
APISetNetworkConfig cfg -> withUser' $ \_ -> withAgent (`setNetworkConfig` cfg) $> CRCmdOk
APIGetNetworkConfig -> CRNetworkConfig <$> withUser' (\_ -> withAgent getNetworkConfig)
APIContactInfo contactId -> withUser $ \User {userId} -> do
ct <- withStore $ \db -> getContact db userId contactId
CRContactInfo ct <$> withAgent (`getConnectionServers` contactConnId ct)
APIGroupMemberInfo gId gMemberId -> withUser $ \user -> do
(g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId
CRGroupMemberInfo g m <$> mapM (withAgent . flip getConnectionServers) (memberConnId m)
-- [incognito] print user's incognito profile for this contact
ct@Contact {activeConn = Connection {customUserProfileId}} <- withStore $ \db -> getContact db userId contactId
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
connectionStats <- withAgent (`getConnectionServers` contactConnId ct)
pure $ CRContactInfo ct connectionStats incognitoProfile
APIGroupMemberInfo gId gMemberId -> withUser $ \user@User {userId} -> do
-- [incognito] print group member main profile
(g, m@GroupMember {memberContactProfileId}) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId
mainProfile <- if memberIncognito m then Just <$> withStore (\db -> getProfileById db userId memberContactProfileId) else pure Nothing
connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m)
pure $ CRGroupMemberInfo g m connectionStats mainProfile
ContactInfo cName -> withUser $ \User {userId} -> do
contactId <- withStore $ \db -> getContactIdByName db userId cName
processChatCommand $ APIContactInfo contactId
@@ -611,20 +618,29 @@ processChatCommand = \case
ChatHelp section -> pure $ CRChatHelp section
Welcome -> withUser $ pure . CRWelcome
AddContact -> withUser $ \User {userId} -> withChatLock . procCmd $ do
-- [incognito] generate profile for connection
incognito <- readTVarIO =<< asks incognitoMode
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
(connId, cReq) <- withAgent (`createConnection` SCMInvitation)
conn <- withStore' $ \db -> createDirectConnection db userId connId ConnNew
conn <- withStore' $ \db -> createDirectConnection db userId connId ConnNew incognitoProfile
toView $ CRNewContactConnection conn
pure $ CRInvitation cReq
Connect (Just (ACR SCMInvitation cReq)) -> withUser $ \User {userId, profile} -> withChatLock . procCmd $ do
connId <- withAgent $ \a -> joinConnection a cReq . directMessage $ XInfo profile
conn <- withStore' $ \db -> createDirectConnection db userId connId ConnJoined
-- [incognito] generate profile to send
incognito <- readTVarIO =<< asks incognitoMode
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = fromMaybe (fromLocalProfile profile) incognitoProfile
connId <- withAgent $ \a -> joinConnection a cReq . directMessage $ XInfo profileToSend
conn <- withStore' $ \db -> createDirectConnection db userId connId ConnJoined incognitoProfile
toView $ CRNewContactConnection conn
pure CRSentConfirmation
Connect (Just (ACR SCMContact cReq)) -> withUser $ \User {userId, profile} ->
connectViaContact userId cReq profile
-- [incognito] generate profile to send
connectViaContact userId cReq $ fromLocalProfile profile
Connect Nothing -> throwChatError CEInvalidConnReq
ConnectSimplex -> withUser $ \User {userId, profile} ->
connectViaContact userId adminContactReq profile
-- [incognito] generate profile to send
connectViaContact userId adminContactReq $ fromLocalProfile profile
DeleteContact cName -> withUser $ \User {userId} -> do
contactId <- withStore $ \db -> getContactIdByName db userId cName
processChatCommand $ APIDeleteChat (ChatRef CTDirect contactId)
@@ -686,29 +702,37 @@ processChatCommand = \case
processChatCommand $ APIUpdateChatItem chatRef editedItemId mc
NewGroup gProfile -> withUser $ \user -> do
gVar <- asks idsDrg
CRGroupCreated <$> withStore (\db -> createNewGroup db gVar user gProfile)
-- [incognito] create membership with incognito profile
incognito <- readTVarIO =<< asks incognitoMode
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
groupInfo <- withStore (\db -> createNewGroup db gVar user gProfile incognitoProfile)
pure $ CRGroupCreated groupInfo incognitoProfile
APIAddMember groupId contactId memRole -> withUser $ \user@User {userId} -> withChatLock $ do
-- TODO for large groups: no need to load all members to determine if contact is a member
(group, contact) <- withStore $ \db -> (,) <$> getGroup db user groupId <*> getContact db userId contactId
-- [incognito] forbid to invite contact to whom user is connected as incognito if user's membership is not incognito
let Group gInfo@GroupInfo {localDisplayName, groupProfile, membership} members = group
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
Contact {localDisplayName = cName} = contact
when (contactConnIncognito contact && not (memberIncognito membership)) $ throwChatError CEGroupNotIncognitoCantInvite
when (userRole < GRAdmin || userRole < memRole) $ throwChatError CEGroupUserRole
when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined gInfo)
unless (memberActive membership) $ throwChatError CEGroupMemberNotActive
let sendInvitation member@GroupMember {groupMemberId, memberId} cReq = do
let groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
-- [incognito] if membership is incognito, send its incognito profile in GroupInvitation
let incognitoProfile = if memberIncognito membership then Just (fromLocalProfile $ memberProfile membership) else Nothing
groupInv = GroupInvitation (MemberIdRole userMemberId userRole) incognitoProfile (MemberIdRole memberId memRole) cReq groupProfile
msg <- sendDirectContactMessage contact $ XGrpInv groupInv
let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending, invitedIncognito = Just $ memberIncognito membership}) memRole
ci <- saveSndChatItem user (CDDirectSnd contact) msg content Nothing Nothing
toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci
setActive $ ActiveG localDisplayName
pure $ CRSentGroupInvitation gInfo contact member
pure $ CRSentGroupInvitation gInfo contact member incognitoProfile
case contactMember contact members of
Nothing -> do
gVar <- asks idsDrg
(agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation)
member <- withStore $ \db -> createContactMember db gVar user groupId contact memRole agentConnId cReq
member <- withStore $ \db -> createNewContactMember db gVar user groupId contact memRole agentConnId cReq
sendInvitation member cReq
Just member@GroupMember {groupMemberId, memberStatus}
| memberStatus == GSMemInvited ->
@@ -719,13 +743,30 @@ processChatCommand = \case
APIJoinGroup groupId -> withUser $ \user@User {userId} -> do
ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership}} <- withStore $ \db -> getGroupInvitation db user groupId
withChatLock . procCmd $ do
agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId (membership :: GroupMember)
-- [incognito] if (incognito mode is enabled OR direct connection with host is incognito) [AND membership is not incognito] update membership to use incognito profile
incognito <- readTVarIO =<< asks incognitoMode
hostConnIncognito <- case (incognito, memberContactId fromMember) of
(True, _) -> pure True -- we don't need to check whether connection with host is incognito if incognito mode is on
(_, Just hostContactId) -> do
hostContact <- withStore $ \db -> getContact db userId hostContactId
pure $ contactConnIncognito hostContact
_ -> pure False
g'@GroupInfo {membership = membership'} <-
if (incognito || hostConnIncognito) && not (memberIncognito membership)
then do
incognitoProfile <- liftIO generateRandomProfile
membership' <- withStore $ \db -> createMemberIncognitoProfile db userId membership (Just incognitoProfile)
pure g {membership = membership'}
else pure g
-- [incognito] if membership is incognito, send its incognito profile in XGrpAcpt
let incognitoProfile = if memberIncognito membership' then Just (fromLocalProfile $ memberProfile membership') else Nothing
agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage $ XGrpAcpt (memberId (membership' :: GroupMember)) incognitoProfile
withStore' $ \db -> do
createMemberConnection db userId fromMember agentConnId
updateGroupMemberStatus db userId fromMember GSMemAccepted
updateGroupMemberStatus db userId membership GSMemAccepted
updateGroupMemberStatus db userId membership' GSMemAccepted
updateCIGroupInvitationStatus user
pure $ CRUserAcceptedGroupSent g {membership = membership {memberStatus = GSMemAccepted}}
pure $ CRUserAcceptedGroupSent g' {membership = membership' {memberStatus = GSMemAccepted}}
where
updateCIGroupInvitationStatus user@User {userId} = do
AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withStore $ \db -> getChatItemByGroupId db user groupId
@@ -750,7 +791,7 @@ processChatCommand = \case
withStore' $ \db -> deleteGroupMember db user m
_ -> do
msg <- sendGroupMessage gInfo members $ XGrpMemDel mId
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId memberProfile) Nothing Nothing
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile)) Nothing Nothing
toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
deleteMemberConnection m
withStore' $ \db -> updateGroupMemberStatus db userId m GSMemRemoved
@@ -861,12 +902,12 @@ processChatCommand = \case
pure $ CRRcvFileCancelled ftr
FileStatus fileId ->
CRFileTransferStatus <$> withUser (\user -> withStore $ \db -> getFileTransferProgress db user fileId)
ShowProfile -> withUser $ \User {profile} -> pure $ CRUserProfile profile
ShowProfile -> withUser $ \User {profile} -> pure $ CRUserProfile (fromLocalProfile profile)
UpdateProfile displayName fullName -> withUser $ \user@User {profile} -> do
let p = (profile :: Profile) {displayName = displayName, fullName = fullName}
let p = (fromLocalProfile profile :: Profile) {displayName = displayName, fullName = fullName}
updateProfile user p
UpdateProfileImage image -> withUser $ \user@User {profile} -> do
let p = (profile :: Profile) {image}
let p = (fromLocalProfile profile :: Profile) {image}
updateProfile user p
QuitChat -> liftIO exitSuccess
ShowVersion -> pure $ CRVersionInfo versionNumber
@@ -910,10 +951,18 @@ processChatCommand = \case
(_, xContactId_) -> procCmd $ do
let randomXContactId = XContactId <$> (asks idsDrg >>= liftIO . (`randomBytes` 16))
xContactId <- maybe randomXContactId pure xContactId_
connId <- withAgent $ \a -> joinConnection a cReq $ directMessage (XContact profile $ Just xContactId)
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId
-- [incognito] generate profile to send
-- if user makes a contact request using main profile, then turns on incognito mode and repeats the request,
-- an incognito profile will be sent even though the address holder will have user's main profile received as well;
-- we ignore this edge case as we already allow profile updates on repeat contact requests;
-- alternatively we can re-send the main profile even if incognito mode is enabled
incognito <- readTVarIO =<< asks incognitoMode
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = fromMaybe profile incognitoProfile
connId <- withAgent $ \a -> joinConnection a cReq $ directMessage (XContact profileToSend $ Just xContactId)
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile
toView $ CRNewContactConnection conn
pure CRSentInvitation
pure $ CRSentInvitation incognitoProfile
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
contactMember Contact {contactId} =
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
@@ -924,17 +973,20 @@ processChatCommand = \case
unlessM (doesFileExist fsFilePath) . throwChatError $ CEFileNotFound f
(,) <$> getFileSize fsFilePath <*> asks (fileChunkSize . config)
updateProfile :: User -> Profile -> m ChatResponse
updateProfile user@User {profile = p} p'@Profile {displayName}
| p' == p = pure CRUserProfileNoChange
updateProfile user@User {profile = p@LocalProfile {profileId}} p'@Profile {displayName}
| p' == fromLocalProfile p = pure CRUserProfileNoChange
| otherwise = do
withStore $ \db -> updateUserProfile db user p'
let user' = (user :: User) {localDisplayName = displayName, profile = p'}
let user' = (user :: User) {localDisplayName = displayName, profile = toLocalProfile profileId p'}
asks currentUser >>= atomically . (`writeTVar` Just user')
contacts <- filter isReady <$> withStore' (`getUserContacts` user)
-- [incognito] filter out contacts with whom user has incognito connections
contacts <-
filter (\ct -> isReady ct && not (contactConnIncognito ct))
<$> withStore' (`getUserContacts` user)
withChatLock . procCmd $ do
forM_ contacts $ \ct ->
void (sendDirectContactMessage ct $ XInfo p') `catchError` (toView . CRChatError)
pure $ CRUserProfileUpdated p p'
pure $ CRUserProfileUpdated (fromLocalProfile p) p'
isReady :: Contact -> Bool
isReady ct =
let s = connStatus $ activeConn (ct :: Contact)
@@ -1117,8 +1169,12 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = F
acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> m Contact
acceptContactRequest User {userId, profile} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} = do
connId <- withAgent $ \a -> acceptContact a invId . directMessage $ XInfo profile
withStore' $ \db -> createAcceptedContact db userId connId cName profileId p userContactLinkId xContactId
-- [incognito] generate profile to send, create connection with incognito profile
incognito <- readTVarIO =<< asks incognitoMode
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = fromMaybe (fromLocalProfile profile) incognitoProfile
connId <- withAgent $ \a -> acceptContact a invId . directMessage $ XInfo profileToSend
withStore' $ \db -> createAcceptedContact db userId connId cName profileId p userContactLinkId xContactId incognitoProfile
agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
agentSubscriber = do
@@ -1192,7 +1248,7 @@ subscribeUserConnections agentBatchSubscribe user = do
groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> m ()
groupSubsToView rs gs ms ce = do
mapM_ groupSub $
sortBy (comparing $ \(Group GroupInfo {localDisplayName = g} _) -> g) gs
sortOn (\(Group GroupInfo {localDisplayName = g} _) -> g) gs
toView . CRMemberSubSummary $ map (uncurry MemberSubStatus) mRs
where
mRs = resultsFor rs ms
@@ -1293,11 +1349,14 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
_ -> Nothing
processDirectMessage :: ACommand 'Agent -> Connection -> Maybe Contact -> m ()
processDirectMessage agentMsg conn@Connection {connId, viaUserContactLink} = \case
processDirectMessage agentMsg conn@Connection {connId, viaUserContactLink, customUserProfileId} = \case
Nothing -> case agentMsg of
CONF confId _ connInfo -> do
-- [incognito] send saved profile
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
let profileToSend = fromMaybe (fromLocalProfile profile) incognitoProfile
saveConnInfo conn connInfo
allowAgentConnection conn confId $ XInfo profile
allowAgentConnection conn confId $ XInfo profileToSend
INFO connInfo ->
saveConnInfo conn connInfo
MSG meta _msgFlags msgBody -> do
@@ -1358,7 +1417,9 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
CON ->
withStore' (\db -> getViaGroupMember db user ct) >>= \case
Nothing -> do
toView $ CRContactConnected ct
-- [incognito] print incognito profile used for this contact
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
toView $ CRContactConnected ct incognitoProfile
setActive $ ActiveC c
showToast (c <> "> ") "connected"
forM_ viaUserContactLink $ \userContactLinkId -> do
@@ -1386,25 +1447,26 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
-- TODO print errors
MERR msgId err -> do
chatItemId_ <- withStore' $ \db -> getChatItemIdByAgentMsgId db connId msgId
case chatItemId_ of
Nothing -> pure ()
Just chatItemId -> do
chatItem <- withStore $ \db -> updateDirectChatItemStatus db userId contactId chatItemId (agentErrToItemStatus err)
toView $ CRChatItemStatusUpdated (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
forM_ chatItemId_ $ \chatItemId -> do
chatItem <- withStore $ \db -> updateDirectChatItemStatus db userId contactId chatItemId (agentErrToItemStatus err)
toView $ CRChatItemStatusUpdated (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
ERR err -> toView . CRChatError $ ChatErrorAgent err
-- TODO add debugging output
_ -> pure ()
processGroupMessage :: ACommand 'Agent -> Connection -> GroupInfo -> GroupMember -> m ()
processGroupMessage agentMsg conn gInfo@GroupInfo {groupId, localDisplayName = gName, membership} m = case agentMsg of
processGroupMessage agentMsg conn gInfo@GroupInfo {groupId, localDisplayName = gName, membership} m@GroupMember {memberContactProfileId} = case agentMsg of
CONF confId _ connInfo -> do
ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
case memberCategory m of
GCInviteeMember ->
case chatMsgEvent of
XGrpAcpt memId
XGrpAcpt memId incognitoProfile
| sameMemberId memId m -> do
withStore' $ \db -> updateGroupMemberStatus db userId m GSMemAccepted
-- [incognito] update member profile to incognito profile
withStore $ \db -> do
liftIO $ updateGroupMemberStatus db userId m GSMemAccepted
void $ createMemberIncognitoProfile db userId m incognitoProfile
allowAgentConnection conn confId XOk
| otherwise -> messageError "x.grp.acpt: memberId is different from expected"
_ -> messageError "CONF from invited member must have x.grp.acpt"
@@ -1413,7 +1475,8 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
XGrpMemInfo memId _memProfile
| sameMemberId memId m -> do
-- TODO update member profile
allowAgentConnection conn confId $ XGrpMemInfo (memberId (membership :: GroupMember)) profile
-- [incognito] send membership incognito profile
allowAgentConnection 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
@@ -1436,13 +1499,17 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
sendPendingGroupMessages m conn
case memberCategory m of
GCHostMember -> do
memberConnectedChatItem gInfo m
toView $ CRUserJoinedGroup gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected}
-- [incognito] chat item & event with indication that host connected incognito
mainProfile <- if memberIncognito m then Just <$> withStore (\db -> getProfileById db userId memberContactProfileId) else pure Nothing
memberConnectedChatItem gInfo m mainProfile
toView $ CRUserJoinedGroup gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} (memberIncognito membership)
setActive $ ActiveG gName
showToast ("#" <> gName) "you are connected to group"
GCInviteeMember -> do
memberConnectedChatItem gInfo m
toView $ CRJoinedGroupMember gInfo m {memberStatus = GSMemConnected}
-- [incognito] chat item & event with indication that invitee connected incognito
mainProfile <- if memberIncognito m then Just <$> withStore (\db -> getProfileById db userId memberContactProfileId) else pure Nothing
memberConnectedChatItem gInfo m mainProfile
toView $ CRJoinedGroupMember gInfo m {memberStatus = GSMemConnected} mainProfile
setActive $ ActiveG gName
showToast ("#" <> gName) $ "member " <> localDisplayName (m :: GroupMember) <> " is connected"
intros <- withStore' $ \db -> createIntroductions db members m
@@ -1629,10 +1696,12 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
cancelRcvFileTransfer user ft
throwChatError $ CEFileRcvChunk err
memberConnectedChatItem :: GroupInfo -> GroupMember -> m ()
memberConnectedChatItem gInfo m = do
memberConnectedChatItem :: GroupInfo -> GroupMember -> Maybe Profile -> m ()
memberConnectedChatItem gInfo m mainProfile_ = do
createdAt <- liftIO getCurrentTime
let content = CIRcvGroupEvent RGEMemberConnected
let content = CIRcvGroupEvent $ case mainProfile_ of
Just mainProfile -> RGEMemberConnected $ Just mainProfile
_ -> RGEMemberConnected Nothing
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
@@ -1641,7 +1710,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
notifyMemberConnected :: GroupInfo -> GroupMember -> m ()
notifyMemberConnected gInfo m@GroupMember {localDisplayName = c} = do
memberConnectedChatItem gInfo m
memberConnectedChatItem gInfo m Nothing
toView $ CRConnectedToGroupMember gInfo m
let g = groupName' gInfo
setActive $ ActiveG g
@@ -1679,13 +1748,12 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
setActive $ ActiveC c
processFileInvitation :: Maybe FileInvitation -> (FileInvitation -> Integer -> m RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv))
processFileInvitation fileInvitation_ createRcvFileTransferF = case fileInvitation_ of
Nothing -> pure Nothing
Just fileInvitation@FileInvitation {fileName, fileSize} -> do
processFileInvitation fileInvitation_ createRcvFileTransferF =
forM fileInvitation_ $ \fileInvitation@FileInvitation {fileName, fileSize} -> do
chSize <- asks $ fileChunkSize . config
RcvFileTransfer {fileId} <- createRcvFileTransferF fileInvitation chSize
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
pure $ Just ciFile
pure ciFile
messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> m ()
messageUpdate ct@Contact {contactId, localDisplayName = c} sharedMsgId mc msg@RcvMessage {msgId} msgMeta = do
@@ -1830,16 +1898,19 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
toView . CRNewChatItem $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci
processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> m ()
processGroupInvitation ct@Contact {localDisplayName = c} inv@(GroupInvitation (MemberIdRole fromMemId fromRole) (MemberIdRole memId memRole) _ _) msg msgMeta = do
processGroupInvitation ct@Contact {localDisplayName = c} inv@GroupInvitation {fromMember = (MemberIdRole fromMemId fromRole), fromMemberProfile, invitedMember = (MemberIdRole memId memRole)} msg msgMeta = do
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c)
when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId
gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = GroupMember {groupMemberId}} <- withStore $ \db -> createGroupInvitation db user ct inv
let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
-- [incognito] if received group invitation has host's incognito profile, create membership with new incognito profile; incognito mode is checked when joining group
let invitedIncognito = isJust fromMemberProfile
incognitoProfile <- if invitedIncognito then Just <$> liftIO generateRandomProfile else pure Nothing
gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = GroupMember {groupMemberId}} <- withStore $ \db -> createGroupInvitation db user ct inv incognitoProfile
let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending, invitedIncognito = Just invitedIncognito}) memRole
ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content Nothing
withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci)
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
toView $ CRReceivedGroupInvitation gInfo ct memRole
toView $ CRReceivedGroupInvitation gInfo ct memRole fromMemberProfile
showToast ("#" <> localDisplayName <> " " <> c <> "> ") "invited you to join the group"
checkIntegrityCreateItem :: forall c. ChatTypeI c => ChatDirection c 'MDRcv -> MsgMeta -> m ()
@@ -1857,23 +1928,27 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
toView $ CRNewChatItem $ AChatItem (chatTypeI @c) SMDRcv (toChatInfo cd) ci
xInfo :: Contact -> Profile -> m ()
xInfo c@Contact {profile = p} p' = unless (p == p') $ do
xInfo c@Contact {profile = p} p' = unless (fromLocalProfile p == p') $ do
c' <- withStore $ \db -> updateContactProfile db userId c p'
toView $ CRContactUpdated c c'
xInfoProbe :: Contact -> Probe -> m ()
xInfoProbe c2 probe = do
r <- withStore' $ \db -> matchReceivedProbe db userId c2 probe
forM_ r $ \c1 -> probeMatch c1 c2 probe
xInfoProbe c2 probe =
-- [incognito] unless connected incognito
unless (contactConnIncognito c2) $ do
r <- withStore' $ \db -> matchReceivedProbe db userId c2 probe
forM_ r $ \c1 -> probeMatch c1 c2 probe
xInfoProbeCheck :: Contact -> ProbeHash -> m ()
xInfoProbeCheck c1 probeHash = do
r <- withStore' $ \db -> matchReceivedProbeHash db userId c1 probeHash
forM_ r . uncurry $ probeMatch c1
xInfoProbeCheck c1 probeHash =
-- [incognito] unless connected incognito
unless (contactConnIncognito c1) $ do
r <- withStore' $ \db -> matchReceivedProbeHash db userId c1 probeHash
forM_ r . uncurry $ probeMatch c1
probeMatch :: Contact -> Contact -> Probe -> m ()
probeMatch c1@Contact {profile = p1} c2@Contact {profile = p2} probe =
when (p1 == p2) $ do
when (fromLocalProfile p1 == fromLocalProfile p2) $ do
void . sendDirectContactMessage c1 $ XInfoProbeOk probe
mergeContacts c1 c2
@@ -2009,7 +2084,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
toView $ CRJoinedGroupMemberConnecting gInfo m newMember
xGrpMemIntro :: Connection -> GroupInfo -> GroupMember -> MemberInfo -> m ()
xGrpMemIntro conn gInfo@GroupInfo {groupId} m memInfo@(MemberInfo memId _ _) = do
xGrpMemIntro conn gInfo@GroupInfo {groupId, membership} m memInfo@(MemberInfo memId _ _) = do
case memberCategory m of
GCHostMember -> do
members <- withStore' $ \db -> getGroupMembers db user gInfo
@@ -2018,7 +2093,9 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
else do
(groupConnId, groupConnReq) <- withAgent (`createConnection` SCMInvitation)
(directConnId, directConnReq) <- withAgent (`createConnection` SCMInvitation)
newMember <- withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnId directConnId
-- [incognito] direct connection with member has to be established using same incognito profile
customUserProfileId <- if memberIncognito membership then Just <$> withStore (\db -> getGroupMemberProfileId db userId membership) else pure Nothing
newMember <- withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnId directConnId customUserProfileId
let msg = XGrpMemInv memId IntroInvitation {groupConnReq, directConnReq}
void $ sendDirectMessage conn msg (GroupId groupId)
withStore' $ \db -> updateGroupMemberStatus db userId newMember GSMemIntroInvited
@@ -2047,10 +2124,12 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
Nothing -> withStore $ \db -> createNewGroupMember db user gInfo memInfo GCPostMember GSMemAnnounced
Just m' -> pure m'
withStore' $ \db -> saveMemberInvitation db toMember introInv
let msg = XGrpMemInfo (memberId (membership :: GroupMember)) profile
-- [incognito] send membership incognito profile, create direct connection as incognito
let msg = XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership)
groupConnId <- withAgent $ \a -> joinConnection a groupConnReq $ directMessage msg
directConnId <- withAgent $ \a -> joinConnection a directConnReq $ directMessage msg
withStore' $ \db -> createIntroToMemberContact db userId m toMember groupConnId directConnId
customUserProfileId <- if memberIncognito membership then Just <$> withStore (\db -> getGroupMemberProfileId db userId membership) else pure Nothing
withStore' $ \db -> createIntroToMemberContact db userId m toMember groupConnId directConnId customUserProfileId
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> MsgMeta -> m ()
xGrpMemDel gInfo@GroupInfo {membership} m memId msg msgMeta = do
@@ -2071,7 +2150,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
else do
deleteMemberConnection member
withStore' $ \db -> updateGroupMemberStatus db userId member GSMemRemoved
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberDeleted groupMemberId memberProfile) Nothing
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberDeleted groupMemberId (fromLocalProfile memberProfile)) Nothing
groupMsgToView gInfo m ci msgMeta
toView $ CRDeletedMember gInfo m member {memberStatus = GSMemRemoved}
@@ -2388,7 +2467,7 @@ getCreateActiveUser st = do
withTransaction st (`setActiveUser` userId user)
pure user
userStr :: User -> String
userStr User {localDisplayName, profile = Profile {fullName}} =
userStr User {localDisplayName, profile = LocalProfile {fullName}} =
T.unpack $ localDisplayName <> if T.null fullName || localDisplayName == fullName then "" else " (" <> fullName <> ")"
getContactName :: IO ContactName
getContactName = do
@@ -2556,6 +2635,7 @@ chatCommandP =
"/profile_image" $> UpdateProfileImage Nothing,
("/profile " <|> "/p ") *> (uncurry UpdateProfile <$> userNames),
("/profile" <|> "/p") $> ShowProfile,
"/incognito " *> (SetIncognito <$> onOffP),
("/quit" <|> "/q" <|> "/exit") $> QuitChat,
("/version" <|> "/v") $> ShowVersion
]
src/Simplex/Chat/Bot.hs
+2 -2
View File
@@ -24,7 +24,7 @@ chatBotRepl welcome answer _user cc = do
race_ (forever $ void getLine) . forever $ do
(_, resp) <- atomically . readTBQueue $ outputQ cc
case resp of
CRContactConnected contact -> do
CRContactConnected contact _ -> do
contactConnected contact
void $ sendMsg contact welcome
CRNewChatItem (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content}) -> do
@@ -40,7 +40,7 @@ initializeBotAddress cc = do
sendChatCmd cc "/show_address" >>= \case
CRUserContactLink uri _ _ -> showBotAddress uri
CRChatCmdError (ChatErrorStore SEUserContactLinkNotFound) -> do
putStrLn $ "No bot address, creating..."
putStrLn "No bot address, creating..."
sendChatCmd cc "/address" >>= \case
CRUserContactLinkCreated uri -> showBotAddress uri
_ -> putStrLn "can't create bot address" >> exitFailure
src/Simplex/Chat/Controller.hs
+13 -10
View File
@@ -88,7 +88,8 @@ data ChatController = ChatController
rcvFiles :: TVar (Map Int64 Handle),
currentCalls :: TMap ContactId Call,
config :: ChatConfig,
filesFolder :: TVar (Maybe FilePath) -- path to files folder for mobile apps
filesFolder :: TVar (Maybe FilePath), -- path to files folder for mobile apps,
incognitoMode :: TVar Bool
}
data HelpSection = HSMain | HSFiles | HSGroups | HSMyAddress | HSMarkdown | HSMessages | HSSettings
@@ -107,6 +108,7 @@ data ChatCommand
| APISuspendChat {suspendTimeout :: Int}
| ResubscribeAllConnections
| SetFilesFolder FilePath
| SetIncognito Bool
| APIExportArchive ArchiveConfig
| APIImportArchive ArchiveConfig
| APIDeleteStorage
@@ -210,8 +212,8 @@ data ChatResponse
| CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
| CRUserSMPServers {smpServers :: [SMPServer]}
| CRNetworkConfig {networkConfig :: NetworkConfig}
| CRContactInfo {contact :: Contact, connectionStats :: ConnectionStats}
| CRGroupMemberInfo {groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats}
| CRContactInfo {contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile}
| CRGroupMemberInfo {groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats, mainProfile :: Maybe Profile}
| CRNewChatItem {chatItem :: AChatItem}
| CRChatItemStatusUpdated {chatItem :: AChatItem}
| CRChatItemUpdated {chatItem :: AChatItem}
@@ -223,7 +225,7 @@ data ChatResponse
| CRCmdOk
| CRChatHelp {helpSection :: HelpSection}
| CRWelcome {user :: User}
| CRGroupCreated {groupInfo :: GroupInfo}
| CRGroupCreated {groupInfo :: GroupInfo, customUserProfile :: Maybe Profile}
| CRGroupMembers {group :: Group}
| CRContactsList {contacts :: [Contact]}
| CRUserContactLink {connReqContact :: ConnReqContact, autoAccept :: Bool, autoReply :: Maybe MsgContent}
@@ -232,14 +234,14 @@ data ChatResponse
| CRUserAcceptedGroupSent {groupInfo :: GroupInfo}
| CRUserDeletedMember {groupInfo :: GroupInfo, member :: GroupMember}
| CRGroupsList {groups :: [GroupInfo]}
| CRSentGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
| CRSentGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember, sentCustomProfile :: Maybe Profile}
| CRFileTransferStatus (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
| CRUserProfile {profile :: Profile}
| CRUserProfileNoChange
| CRVersionInfo {version :: String}
| CRInvitation {connReqInvitation :: ConnReqInvitation}
| CRSentConfirmation
| CRSentInvitation
| CRSentInvitation {customUserProfile :: Maybe Profile}
| CRContactUpdated {fromContact :: Contact, toContact :: Contact}
| CRContactsMerged {intoContact :: Contact, mergedContact :: Contact}
| CRContactDeleted {contact :: Contact}
@@ -265,7 +267,7 @@ data ChatResponse
| CRSndGroupFileCancelled {chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]}
| CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile}
| CRContactConnecting {contact :: Contact}
| CRContactConnected {contact :: Contact}
| CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile}
| CRContactAnotherClient {contact :: Contact}
| CRContactsDisconnected {server :: SMPServer, contactRefs :: [ContactRef]}
| CRContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]}
@@ -274,9 +276,9 @@ data ChatResponse
| CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRGroupInvitation {groupInfo :: GroupInfo}
| CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole}
| CRUserJoinedGroup {groupInfo :: GroupInfo, hostMember :: GroupMember}
| CRJoinedGroupMember {groupInfo :: GroupInfo, member :: GroupMember}
| CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole, receivedCustomProfile :: Maybe Profile}
| CRUserJoinedGroup {groupInfo :: GroupInfo, hostMember :: GroupMember, usedCustomProfile :: Bool}
| CRJoinedGroupMember {groupInfo :: GroupInfo, member :: GroupMember, mainProfile :: Maybe Profile}
| CRJoinedGroupMemberConnecting {groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
| CRConnectedToGroupMember {groupInfo :: GroupInfo, member :: GroupMember}
| CRDeletedMember {groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember}
@@ -383,6 +385,7 @@ data ChatErrorType
| CEContactNotReady {contact :: Contact}
| CEContactGroups {contact :: Contact, groupNames :: [GroupName]}
| CEGroupUserRole
| CEGroupNotIncognitoCantInvite
| CEGroupContactRole {contactName :: ContactName}
| CEGroupDuplicateMember {contactName :: ContactName}
| CEGroupDuplicateMemberId
src/Simplex/Chat/Help.hs
+2 -2
View File
@@ -18,7 +18,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import Simplex.Chat.Markdown
import Simplex.Chat.Styled
import Simplex.Chat.Types (Profile (..), User (..))
import Simplex.Chat.Types (User (..), LocalProfile (..))
import System.Console.ANSI.Types
highlight :: Text -> Markdown
@@ -55,7 +55,7 @@ chatWelcome user =
"Type " <> highlight "/help" <> " for usage info, " <> highlight "/welcome" <> " to show this message"
]
where
User {profile = Profile {displayName, fullName}} = user
User {profile = LocalProfile {displayName, fullName}} = user
userName = if T.null fullName then displayName else fullName
chatHelpInfo :: [StyledString]
src/Simplex/Chat/Messages.hs
+13 -10
View File
@@ -501,22 +501,24 @@ ciGroupInvitationToText CIGroupInvitation {groupProfile = GroupProfile {displayN
rcvGroupEventToText :: RcvGroupEvent -> Text
rcvGroupEventToText = \case
RGEMemberAdded _ p -> "added " <> memberProfileToText p
RGEMemberConnected -> "connected"
RGEMemberAdded _ p -> "added " <> profileToText p
RGEMemberConnected contactMainProfile -> case contactMainProfile of
Just p -> profileToText p <> " connected incognito"
Nothing -> "connected"
RGEMemberLeft -> "left"
RGEMemberDeleted _ p -> "removed " <> memberProfileToText p
RGEMemberDeleted _ p -> "removed " <> profileToText p
RGEUserDeleted -> "removed you"
RGEGroupDeleted -> "deleted group"
RGEGroupUpdated _ -> "group profile updated"
sndGroupEventToText :: SndGroupEvent -> Text
sndGroupEventToText = \case
SGEMemberDeleted _ p -> "removed " <> memberProfileToText p
SGEMemberDeleted _ p -> "removed " <> profileToText p
SGEUserLeft -> "left"
SGEGroupUpdated _ -> "group profile updated"
memberProfileToText :: Profile -> Text
memberProfileToText Profile {displayName, fullName} = displayName <> optionalFullName displayName fullName
profileToText :: Profile -> Text
profileToText Profile {displayName, fullName} = displayName <> optionalFullName displayName fullName
-- This type is used both in API and in DB, so we use different JSON encodings for the database and for the API
data CIContent (d :: MsgDirection) where
@@ -536,7 +538,7 @@ deriving instance Show (CIContent d)
data RcvGroupEvent
= RGEMemberAdded {groupMemberId :: GroupMemberId, profile :: Profile} -- CRJoinedGroupMemberConnecting
| RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember
| RGEMemberConnected {contactMainProfile :: Maybe Profile} -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember
| RGEMemberLeft -- CRLeftMember
| RGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRDeletedMember
| RGEUserDeleted -- CRDeletedMemberUser
@@ -569,13 +571,14 @@ data CIGroupInvitation = CIGroupInvitation
groupMemberId :: GroupMemberId,
localDisplayName :: GroupName,
groupProfile :: GroupProfile,
status :: CIGroupInvitationStatus
status :: CIGroupInvitationStatus,
invitedIncognito :: Maybe Bool
}
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON CIGroupInvitation where
toJSON = J.genericToJSON J.defaultOptions
toEncoding = J.genericToEncoding J.defaultOptions
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
data CIGroupInvitationStatus
= CIGISPending
src/Simplex/Chat/Migrations/M20220812_incognito_profiles.hs
+16
View File
@@ -0,0 +1,16 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220812_incognito_profiles where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20220812_incognito_profiles :: Query
m20220812_incognito_profiles =
[sql|
ALTER TABLE connections ADD COLUMN custom_user_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL; -- only set for direct connections
ALTER TABLE group_members ADD COLUMN member_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL; -- member profile id if incognito profile was saved for member (used for hosts and invitees in incognito groups)
ALTER TABLE contact_profiles ADD COLUMN incognito INTEGER; -- 1 for incognito
|]
src/Simplex/Chat/Migrations/chat_schema.sql
+4 -1
View File
@@ -13,7 +13,8 @@ CREATE TABLE contact_profiles(
created_at TEXT CHECK(created_at NOT NULL),
updated_at TEXT CHECK(updated_at NOT NULL),
image TEXT,
user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE
user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE,
incognito INTEGER
);
CREATE INDEX contact_profiles_index ON contact_profiles(
display_name,
@@ -145,6 +146,7 @@ CREATE TABLE group_members(
contact_id INTEGER REFERENCES contacts ON DELETE CASCADE,
created_at TEXT CHECK(created_at NOT NULL),
updated_at TEXT CHECK(updated_at NOT NULL),
member_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
@@ -236,6 +238,7 @@ CREATE TABLE connections(
xcontact_id BLOB,
via_user_contact_link INTEGER DEFAULT NULL
REFERENCES user_contact_links(user_contact_link_id) ON DELETE SET NULL,
custom_user_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
FOREIGN KEY(snd_file_id, connection_id)
REFERENCES snd_files(file_id, connection_id)
ON DELETE CASCADE
src/Simplex/Chat/ProfileGenerator.hs
+3140
View File
File diff suppressed because it is too large Load Diff
src/Simplex/Chat/Protocol.hs
+4 -4
View File
@@ -124,7 +124,7 @@ data ChatMsgEvent
| XInfo Profile
| XContact Profile (Maybe XContactId)
| XGrpInv GroupInvitation
| XGrpAcpt MemberId
| XGrpAcpt MemberId (Maybe Profile)
| XGrpMemNew MemberInfo
| XGrpMemIntro MemberInfo
| XGrpMemInv MemberId IntroInvitation
@@ -413,7 +413,7 @@ toCMEventTag = \case
XInfo _ -> XInfo_
XContact _ _ -> XContact_
XGrpInv _ -> XGrpInv_
XGrpAcpt _ -> XGrpAcpt_
XGrpAcpt _ _ -> XGrpAcpt_
XGrpMemNew _ -> XGrpMemNew_
XGrpMemIntro _ -> XGrpMemIntro_
XGrpMemInv _ _ -> XGrpMemInv_
@@ -479,7 +479,7 @@ appToChatMessage AppMessage {msgId, event, params} = do
XInfo_ -> XInfo <$> p "profile"
XContact_ -> XContact <$> p "profile" <*> opt "contactReqId"
XGrpInv_ -> XGrpInv <$> p "groupInvitation"
XGrpAcpt_ -> XGrpAcpt <$> p "memberId"
XGrpAcpt_ -> XGrpAcpt <$> p "memberId" <*> opt "memberProfile"
XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo"
XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
@@ -521,7 +521,7 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = AppMessage {msgId, event, p
XInfo profile -> o ["profile" .= profile]
XContact profile xContactId -> o $ ("contactReqId" .=? xContactId) ["profile" .= profile]
XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
XGrpAcpt memId -> o ["memberId" .= memId]
XGrpAcpt memId profile -> o $ ("memberProfile" .=? profile) ["memberId" .= memId]
XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]
XGrpMemIntro memInfo -> o ["memberInfo" .= memInfo]
XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]
src/Simplex/Chat/Store.hs
+363 -275
View File
File diff suppressed because it is too large Load Diff
src/Simplex/Chat/Types.hs
+51 -7
View File
@@ -22,6 +22,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
@@ -39,7 +40,7 @@ import Simplex.Messaging.Util ((<$?>))
class IsContact a where
contactId' :: a -> ContactId
profile' :: a -> Profile
profile' :: a -> LocalProfile
localDisplayName' :: a -> ContactName
instance IsContact User where
@@ -56,7 +57,7 @@ data User = User
{ userId :: UserId,
userContactId :: ContactId,
localDisplayName :: ContactName,
profile :: Profile,
profile :: LocalProfile,
activeUser :: Bool
}
deriving (Show, Generic, FromJSON)
@@ -67,10 +68,12 @@ type UserId = ContactId
type ContactId = Int64
type ProfileId = Int64
data Contact = Contact
{ contactId :: ContactId,
localDisplayName :: ContactName,
profile :: Profile,
profile :: LocalProfile,
activeConn :: Connection,
viaGroup :: Maybe Int64,
createdAt :: UTCTime,
@@ -88,6 +91,9 @@ contactConn = activeConn
contactConnId :: Contact -> ConnId
contactConnId Contact {activeConn} = aConnId activeConn
contactConnIncognito :: Contact -> Bool
contactConnIncognito Contact {activeConn = Connection {customUserProfileId}} = isJust customUserProfileId
data ContactRef = ContactRef
{ contactId :: ContactId,
localDisplayName :: ContactName
@@ -198,6 +204,7 @@ data Profile = Profile
{ displayName :: ContactName,
fullName :: Text,
image :: Maybe ImageData
-- incognito field should not be read as is into this data type to prevent sending it as part of profile to contacts
}
deriving (Eq, Show, Generic, FromJSON)
@@ -205,6 +212,29 @@ instance ToJSON Profile where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
data LocalProfile = LocalProfile
{ profileId :: ProfileId,
displayName :: ContactName,
fullName :: Text,
image :: Maybe ImageData
}
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON LocalProfile where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
localProfileId :: LocalProfile -> ProfileId
localProfileId = profileId
toLocalProfile :: ProfileId -> Profile -> LocalProfile
toLocalProfile profileId Profile {displayName, fullName, image} =
LocalProfile {profileId, displayName, fullName, image}
fromLocalProfile :: LocalProfile -> Profile
fromLocalProfile LocalProfile {displayName, fullName, image} =
Profile {displayName, fullName, image}
data GroupProfile = GroupProfile
{ displayName :: GroupName,
fullName :: Text,
@@ -232,13 +262,16 @@ instance FromField ImageData where fromField = fmap ImageData . fromField
data GroupInvitation = GroupInvitation
{ fromMember :: MemberIdRole,
fromMemberProfile :: Maybe Profile,
invitedMember :: MemberIdRole,
connRequest :: ConnReqInvitation,
groupProfile :: GroupProfile
}
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON GroupInvitation where toEncoding = J.genericToEncoding J.defaultOptions
instance ToJSON GroupInvitation where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
data MemberIdRole = MemberIdRole
{ memberId :: MemberId,
@@ -267,7 +300,7 @@ instance ToJSON MemberInfo where toEncoding = J.genericToEncoding J.defaultOptio
memberInfo :: GroupMember -> MemberInfo
memberInfo GroupMember {memberId, memberRole, memberProfile} =
MemberInfo memberId memberRole memberProfile
MemberInfo memberId memberRole (fromLocalProfile memberProfile)
data ReceivedGroupInvitation = ReceivedGroupInvitation
{ fromMember :: GroupMember,
@@ -278,6 +311,8 @@ data ReceivedGroupInvitation = ReceivedGroupInvitation
type GroupMemberId = Int64
-- memberProfile's profileId is COALESCE(member_profile_id, contact_profile_id), member_profile_id is non null
-- if incognito profile was saved for member (used for hosts and invitees in incognito groups)
data GroupMember = GroupMember
{ groupMemberId :: GroupMemberId,
groupId :: GroupId,
@@ -287,8 +322,9 @@ data GroupMember = GroupMember
memberStatus :: GroupMemberStatus,
invitedBy :: InvitedBy,
localDisplayName :: ContactName,
memberProfile :: Profile,
memberContactId :: Maybe Int64,
memberProfile :: LocalProfile,
memberContactId :: Maybe ContactId,
memberContactProfileId :: ProfileId,
activeConn :: Maybe Connection
}
deriving (Eq, Show, Generic)
@@ -306,6 +342,9 @@ memberConnId GroupMember {activeConn} = aConnId <$> activeConn
groupMemberId' :: GroupMember -> GroupMemberId
groupMemberId' GroupMember {groupMemberId} = groupMemberId
memberIncognito :: GroupMember -> Bool
memberIncognito GroupMember {memberProfile, memberContactProfileId} = localProfileId memberProfile /= memberContactProfileId
data NewGroupMember = NewGroupMember
{ memInfo :: MemberInfo,
memCategory :: GroupMemberCategory,
@@ -695,6 +734,7 @@ data Connection = Connection
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"
customUserProfileId :: Maybe Int64,
connType :: ConnType,
connStatus :: ConnStatus,
entityId :: Maybe Int64, -- contact, group member, file ID or user contact ID
@@ -705,6 +745,9 @@ data Connection = Connection
aConnId :: Connection -> ConnId
aConnId Connection {agentConnId = AgentConnId cId} = cId
connCustomUserProfileId :: Connection -> Maybe Int64
connCustomUserProfileId Connection {customUserProfileId} = customUserProfileId
instance ToJSON Connection where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
@@ -715,6 +758,7 @@ data PendingContactConnection = PendingContactConnection
pccConnStatus :: ConnStatus,
viaContactUri :: Bool,
viaUserContactLink :: Maybe Int64,
customUserProfileId :: Maybe Int64,
createdAt :: UTCTime,
updatedAt :: UTCTime
}
src/Simplex/Chat/View.hs
+146 -42
View File
@@ -54,7 +54,7 @@ serializeChatResponse = unlines . map unStyle . responseToView False
responseToView :: Bool -> ChatResponse -> [StyledString]
responseToView testView = \case
CRActiveUser User {profile} -> viewUserProfile profile
CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
CRChatStarted -> ["chat started"]
CRChatRunning -> ["chat is running"]
CRChatStopped -> ["chat stopped"]
@@ -64,8 +64,8 @@ responseToView testView = \case
CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft]
CRUserSMPServers smpServers -> viewSMPServers smpServers testView
CRNetworkConfig cfg -> viewNetworkConfig cfg
CRContactInfo ct cStats -> viewContactInfo ct cStats
CRGroupMemberInfo g m cStats -> viewGroupMemberInfo g m cStats
CRContactInfo ct cStats customUserProfile -> viewContactInfo ct cStats customUserProfile
CRGroupMemberInfo g m cStats mainProfile -> viewGroupMemberInfo g m cStats mainProfile
CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item False
CRLastMessages chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True) chatItems
CRChatItemStatusUpdated _ -> []
@@ -89,10 +89,10 @@ responseToView testView = \case
CRUserContactLink cReqUri autoAccept autoReply -> connReqContact_ "Your chat address:" cReqUri <> autoAcceptStatus_ autoAccept autoReply
CRUserContactLinkUpdated _ autoAccept autoReply -> autoAcceptStatus_ autoAccept autoReply
CRContactRequestRejected UserContactRequest {localDisplayName = c} -> [ttyContact c <> ": contact request rejected"]
CRGroupCreated g -> viewGroupCreated g
CRGroupCreated g customUserProfile -> viewGroupCreated g customUserProfile testView
CRGroupMembers g -> viewGroupMembers g
CRGroupsList gs -> viewGroupsList gs
CRSentGroupInvitation g c _ -> ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
CRSentGroupInvitation g c _ sentCustomProfile -> viewSentGroupInvitation g c sentCustomProfile
CRFileTransferStatus ftStatus -> viewFileTransferStatus ftStatus
CRUserProfile p -> viewUserProfile p
CRUserProfileNoChange -> ["user profile did not change"]
@@ -100,7 +100,7 @@ responseToView testView = \case
CRChatCmdError e -> viewChatError e
CRInvitation cReq -> viewConnReqInvitation cReq
CRSentConfirmation -> ["confirmation sent!"]
CRSentInvitation -> ["connection request sent!"]
CRSentInvitation customUserProfile -> viewSentInvitation customUserProfile testView
CRContactDeleted c -> [ttyContact' c <> ": contact is deleted"]
CRChatCleared chatInfo -> viewChatCleared chatInfo
CRAcceptingContactRequest c -> [ttyFullContact c <> ": accepting contact request..."]
@@ -129,7 +129,7 @@ responseToView testView = \case
CRSndFileRcvCancelled _ ft@SndFileTransfer {recipientDisplayName = c} ->
[ttyContact c <> " cancelled receiving " <> sndFile ft]
CRContactConnecting _ -> []
CRContactConnected ct -> [ttyFullContact ct <> ": contact is connected"]
CRContactConnected ct userCustomProfile -> viewContactConnected ct userCustomProfile testView
CRContactAnotherClient c -> [ttyContact' c <> ": contact is connected to another client"]
CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactsSubscribed srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
@@ -138,13 +138,13 @@ responseToView testView = \case
[sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
where
(errors, subscribed) = partition (isJust . contactError) summary
CRGroupInvitation GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership} ->
[groupInvitation' ldn fullName $ memberIncognito membership]
CRReceivedGroupInvitation g c role receivedCustomProfile -> viewReceivedGroupInvitation g c role receivedCustomProfile
CRUserJoinedGroup g _ usedCustomProfile -> viewUserJoinedGroup g usedCustomProfile testView
CRJoinedGroupMember g m mainProfile -> viewJoinedGroupMember g m mainProfile
CRHostConnected p h -> [plain $ "connected to " <> viewHostEvent p h]
CRHostDisconnected p h -> [plain $ "disconnected from " <> viewHostEvent p h]
CRGroupInvitation GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} ->
[groupInvitation' ldn fullName]
CRReceivedGroupInvitation g c role -> viewReceivedGroupInvitation g c role
CRUserJoinedGroup g _ -> [ttyGroup' g <> ": you joined the group"]
CRJoinedGroupMember g m -> [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "]
CRJoinedGroupMemberConnecting g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
CRConnectedToGroupMember g m -> [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
CRDeletedMemberUser g by -> [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
@@ -156,7 +156,7 @@ responseToView testView = \case
CRGroupUpdated g g' m -> viewGroupUpdated g g' m
CRMemberSubError g m e -> [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
CRMemberSubSummary summary -> viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
CRGroupSubscribed g -> [ttyFullGroup g <> ": connected to server(s)"]
CRGroupSubscribed g -> viewGroupSubscribed g
CRPendingSubSummary _ -> []
CRSndFileSubError SndFileTransfer {fileId, fileName} e ->
["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
@@ -208,6 +208,12 @@ responseToView testView = \case
contactList :: [ContactRef] -> String
contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs
viewGroupSubscribed :: GroupInfo -> [StyledString]
viewGroupSubscribed g@GroupInfo {membership} =
[incognito <> ttyFullGroup g <> ": connected to server(s)"]
where
incognito = if memberIncognito membership then incognitoPrefix else ""
showSMPServer :: SMPServer -> String
showSMPServer = B.unpack . strEncode . host
@@ -363,6 +369,12 @@ viewConnReqInvitation cReq =
"and ask them to connect: " <> highlight' "/c <invitation_link_above>"
]
viewSentGroupInvitation :: GroupInfo -> Contact -> Maybe Profile -> [StyledString]
viewSentGroupInvitation g c sentCustomProfile =
if isJust sentCustomProfile
then ["invitation to join the group " <> ttyGroup' g <> " incognito sent to " <> ttyContact' c]
else ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
viewChatCleared :: AChatInfo -> [StyledString]
viewChatCleared (AChatInfo _ chatInfo) = case chatInfo of
DirectChat ct -> [ttyContact' ct <> ": all messages are removed locally ONLY"]
@@ -372,7 +384,8 @@ viewChatCleared (AChatInfo _ chatInfo) = case chatInfo of
viewContactsList :: [Contact] -> [StyledString]
viewContactsList =
let ldn = T.toLower . (localDisplayName :: Contact -> ContactName)
in map ttyFullContact . sortOn ldn
incognito ct = if contactConnIncognito ct then incognitoPrefix else ""
in map (\ct -> incognito ct <> ttyFullContact ct) . sortOn ldn
viewUserContactLinkDeleted :: [StyledString]
viewUserContactLinkDeleted =
@@ -396,6 +409,17 @@ autoAcceptStatus_ autoAccept autoReply =
("auto_accept " <> if autoAccept then "on" else "off") :
maybe [] ((["auto reply:"] <>) . ttyMsgContent) autoReply
viewSentInvitation :: Maybe Profile -> Bool -> [StyledString]
viewSentInvitation incognitoProfile testView =
case incognitoProfile of
Just profile ->
if testView
then incognitoProfile' profile : message
else message
where
message = ["connection request sent incognito!"]
Nothing -> ["connection request sent!"]
viewReceivedContactRequest :: ContactName -> Profile -> [StyledString]
viewReceivedContactRequest c Profile {fullName} =
[ ttyFullName c fullName <> " wants to connect to you!",
@@ -403,11 +427,22 @@ viewReceivedContactRequest c Profile {fullName} =
"to reject: " <> highlight ("/rc " <> c) <> " (the sender will NOT be notified)"
]
viewGroupCreated :: GroupInfo -> [StyledString]
viewGroupCreated g@GroupInfo {localDisplayName} =
[ "group " <> ttyFullGroup g <> " is created",
"use " <> highlight ("/a " <> localDisplayName <> " <name>") <> " to add members"
]
viewGroupCreated :: GroupInfo -> Maybe Profile -> Bool -> [StyledString]
viewGroupCreated g@GroupInfo {localDisplayName} incognitoProfile testView =
case incognitoProfile of
Just profile ->
if testView
then incognitoProfile' profile : message
else message
where
message =
[ "group " <> ttyFullGroup g <> " is created incognito, your profile for this group: " <> incognitoProfile' profile,
"use " <> highlight ("/a " <> localDisplayName <> " <name>") <> " to add members"
]
Nothing ->
[ "group " <> ttyFullGroup g <> " is created",
"use " <> highlight ("/a " <> localDisplayName <> " <name>") <> " to add members"
]
viewCannotResendInvitation :: GroupInfo -> ContactName -> [StyledString]
viewCannotResendInvitation GroupInfo {localDisplayName = gn} c =
@@ -415,11 +450,33 @@ viewCannotResendInvitation GroupInfo {localDisplayName = gn} c =
"to re-send invitation: " <> highlight ("/rm " <> gn <> " " <> c) <> ", " <> highlight ("/a " <> gn <> " " <> c)
]
viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [StyledString]
viewReceivedGroupInvitation g c role =
[ ttyFullGroup g <> ": " <> ttyContact' c <> " invites you to join the group as " <> plain (strEncode role),
"use " <> highlight ("/j " <> groupName' g) <> " to accept"
]
viewUserJoinedGroup :: GroupInfo -> Bool -> Bool -> [StyledString]
viewUserJoinedGroup g@GroupInfo {membership = GroupMember {memberProfile}} incognito testView =
if incognito
then
if testView
then incognitoProfile' (fromLocalProfile memberProfile) : incognitoMessage
else incognitoMessage
else [ttyGroup' g <> ": you joined the group"]
where
incognitoMessage = [ttyGroup' g <> ": you joined the group incognito as " <> incognitoProfile' (fromLocalProfile memberProfile)]
viewJoinedGroupMember :: GroupInfo -> GroupMember -> Maybe Profile -> [StyledString]
viewJoinedGroupMember g m@GroupMember {localDisplayName} = \case
Just Profile {displayName = mainProfileName} -> [ttyGroup' g <> ": " <> ttyContact mainProfileName <> " joined the group incognito as " <> styleIncognito localDisplayName]
Nothing -> [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "]
viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> Maybe Profile -> [StyledString]
viewReceivedGroupInvitation g c role hostIncognitoProfile =
case hostIncognitoProfile of
Just profile ->
[ ttyFullGroup g <> ": " <> ttyContact' c <> " (known to the group as " <> incognitoProfile' profile <> ") invites you to join the group incognito as " <> plain (strEncode role),
"use " <> highlight ("/j " <> groupName' g) <> " to join this group incognito"
]
Nothing ->
[ ttyFullGroup g <> ": " <> ttyContact' c <> " invites you to join the group as " <> plain (strEncode role),
"use " <> highlight ("/j " <> groupName' g) <> " to accept"
]
groupPreserved :: GroupInfo -> [StyledString]
groupPreserved g = ["use " <> highlight ("/d #" <> groupName' g) <> " to delete the group"]
@@ -434,7 +491,8 @@ viewGroupMembers :: Group -> [StyledString]
viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filter (not . removedOrLeft) $ membership : members
where
removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
groupMember m = ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m
groupMember m = incognito m <> ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m
incognito m = if memberIncognito m then incognitoPrefix else ""
role m = plain . strEncode $ memberRole (m :: GroupMember)
category m = case memberCategory m of
GCUserMember -> "you, "
@@ -450,6 +508,21 @@ viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filt
GSMemCreator -> "created group"
_ -> ""
viewContactConnected :: Contact -> Maybe Profile -> Bool -> [StyledString]
viewContactConnected ct@Contact {localDisplayName} userIncognitoProfile testView =
case userIncognitoProfile of
Just profile ->
if testView
then incognitoProfile' profile : message
else message
where
message =
[ ttyFullContact ct <> ": contact is connected, your incognito profile for this contact is " <> incognitoProfile' profile,
"use " <> highlight ("/info " <> localDisplayName) <> " to print out this incognito profile again"
]
Nothing ->
[ttyFullContact ct <> ": contact is connected"]
viewGroupsList :: [GroupInfo] -> [StyledString]
viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
viewGroupsList gs = map groupSS $ sortOn ldn_ gs
@@ -457,9 +530,10 @@ viewGroupsList gs = map groupSS $ sortOn ldn_ gs
ldn_ = T.toLower . (localDisplayName :: GroupInfo -> GroupName)
groupSS GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership} =
case memberStatus membership of
GSMemInvited -> groupInvitation' ldn fullName
s -> ttyGroup ldn <> optFullName ldn fullName <> viewMemberStatus s
GSMemInvited -> groupInvitation' ldn fullName $ memberIncognito membership
s -> incognito <> ttyGroup ldn <> optFullName ldn fullName <> viewMemberStatus s
where
incognito = if memberIncognito membership then incognitoPrefix else ""
viewMemberStatus = \case
GSMemRemoved -> delete "you are removed"
GSMemLeft -> delete "you left"
@@ -467,15 +541,20 @@ viewGroupsList gs = map groupSS $ sortOn ldn_ gs
_ -> ""
delete reason = " (" <> reason <> ", delete local copy: " <> highlight ("/d #" <> ldn) <> ")"
groupInvitation' :: GroupName -> Text -> StyledString
groupInvitation' displayName fullName =
groupInvitation' :: GroupName -> Text -> Bool -> StyledString
groupInvitation' displayName fullName membershipIncognito =
highlight ("#" <> displayName)
<> optFullName displayName fullName
<> " - you are invited ("
<> invitationText
<> highlight ("/j " <> displayName)
<> " to join, "
<> highlight ("/d #" <> displayName)
<> " to delete invitation)"
where
invitationText =
if membershipIncognito
then " - you are invited incognito ("
else " - you are invited ("
viewContactsMerged :: Contact -> Contact -> [StyledString]
viewContactsMerged _into@Contact {localDisplayName = c1} _merged@Contact {localDisplayName = c2} =
@@ -514,16 +593,24 @@ viewNetworkConfig NetworkConfig {socksProxy, tcpTimeout} =
"use `/network socks=<on/off/[ipv4]:port>[ timeout=<seconds>]` to change settings"
]
viewContactInfo :: Contact -> ConnectionStats -> [StyledString]
viewContactInfo Contact {contactId} stats =
viewContactInfo :: Contact -> ConnectionStats -> Maybe Profile -> [StyledString]
viewContactInfo Contact {contactId} stats incognitoProfile =
["contact ID: " <> sShow contactId] <> viewConnectionStats stats
<> maybe
["you've shared main profile with this contact"]
(\p -> ["you've shared incognito profile with this contact: " <> incognitoProfile' p])
incognitoProfile
viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> [StyledString]
viewGroupMemberInfo GroupInfo {groupId} GroupMember {groupMemberId} stats =
viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> Maybe Profile -> [StyledString]
viewGroupMemberInfo GroupInfo {groupId} GroupMember {groupMemberId} stats mainProfile =
[ "group ID: " <> sShow groupId,
"member ID: " <> sShow groupMemberId
]
<> maybe ["member not connected"] viewConnectionStats stats
<> maybe
["unknown whether group member uses his main profile or incognito one for the group"]
(\Profile {displayName, fullName} -> ["member is using " <> styleIncognito' "incognito" <> " profile for the group, main profile known: " <> ttyFullName displayName fullName])
mainProfile
viewConnectionStats :: ConnectionStats -> [StyledString]
viewConnectionStats ConnectionStats {rcvServers, sndServers} =
@@ -559,8 +646,8 @@ viewGroupUpdated
viewContactUpdated :: Contact -> Contact -> [StyledString]
viewContactUpdated
Contact {localDisplayName = n, profile = Profile {fullName}}
Contact {localDisplayName = n', profile = Profile {fullName = fullName'}}
Contact {localDisplayName = n, profile = LocalProfile {fullName}}
Contact {localDisplayName = n', profile = LocalProfile {fullName = fullName'}}
| n == n' && fullName == fullName' = []
| n == n' = ["contact " <> ttyContact n <> fullNameUpdate]
| otherwise =
@@ -817,6 +904,7 @@ viewChatError = \case
CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"]
CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"]
CEGroupUserRole -> ["you have insufficient permissions for this group command"]
CEGroupNotIncognitoCantInvite -> ["you're using main profile for this group - prohibited to invite contact to whom you are connected incognito"]
CEGroupContactRole c -> ["contact " <> ttyContact c <> " has insufficient permissions for this group action"]
CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> groupName' g)]
CEGroupMemberNotActive -> ["you cannot invite other members yet, try later"]
@@ -883,14 +971,14 @@ ttyContact' :: Contact -> StyledString
ttyContact' Contact {localDisplayName = c} = ttyContact c
ttyFullContact :: Contact -> StyledString
ttyFullContact Contact {localDisplayName, profile = Profile {fullName}} =
ttyFullContact Contact {localDisplayName, profile = LocalProfile {fullName}} =
ttyFullName localDisplayName fullName
ttyMember :: GroupMember -> StyledString
ttyMember GroupMember {localDisplayName} = ttyContact localDisplayName
ttyFullMember :: GroupMember -> StyledString
ttyFullMember GroupMember {localDisplayName, memberProfile = Profile {fullName}} =
ttyFullMember GroupMember {localDisplayName, memberProfile = LocalProfile {fullName}} =
ttyFullName localDisplayName fullName
ttyFullName :: ContactName -> Text -> StyledString
@@ -909,7 +997,8 @@ ttyFromContactDeleted :: ContactName -> StyledString
ttyFromContactDeleted c = ttyFrom $ c <> "> [deleted] "
ttyToContact' :: Contact -> StyledString
ttyToContact' Contact {localDisplayName = c} = ttyToContact c
ttyToContact' Contact {localDisplayName = c, activeConn = Connection {customUserProfileId}} =
maybe "" (const incognitoPrefix) customUserProfileId <> ttyToContact c
ttyQuotedContact :: Contact -> StyledString
ttyQuotedContact Contact {localDisplayName = c} = ttyFrom $ c <> ">"
@@ -919,7 +1008,8 @@ ttyQuotedMember (Just GroupMember {localDisplayName = c}) = "> " <> ttyFrom c
ttyQuotedMember _ = "> " <> ttyFrom "?"
ttyFromContact' :: Contact -> StyledString
ttyFromContact' Contact {localDisplayName = c} = ttyFromContact c
ttyFromContact' Contact {localDisplayName = c, activeConn = Connection {customUserProfileId}} =
maybe "" (const incognitoPrefix) customUserProfileId <> ttyFromContact c
ttyGroup :: GroupName -> StyledString
ttyGroup g = styled (colored Blue) $ "#" <> g
@@ -949,10 +1039,12 @@ ttyFrom :: Text -> StyledString
ttyFrom = styled $ colored Yellow
ttyFromGroup' :: GroupInfo -> GroupMember -> StyledString
ttyFromGroup' g GroupMember {localDisplayName = m} = ttyFromGroup g m
ttyFromGroup' g@GroupInfo {membership} GroupMember {localDisplayName = m} =
(if memberIncognito membership then incognitoPrefix else "") <> ttyFromGroup g m
ttyToGroup :: GroupInfo -> StyledString
ttyToGroup GroupInfo {localDisplayName = g} = styled (colored Cyan) $ "#" <> g <> " "
ttyToGroup GroupInfo {localDisplayName = g, membership} =
(if memberIncognito membership then incognitoPrefix else "") <> styled (colored Cyan) ("#" <> g <> " ")
ttyFilePath :: FilePath -> StyledString
ttyFilePath = plain
@@ -960,12 +1052,24 @@ ttyFilePath = plain
optFullName :: ContactName -> Text -> StyledString
optFullName localDisplayName fullName = plain $ optionalFullName localDisplayName fullName
incognitoPrefix :: StyledString
incognitoPrefix = styleIncognito' "i "
incognitoProfile' :: Profile -> StyledString
incognitoProfile' Profile {displayName} = styleIncognito displayName
highlight :: StyledFormat a => a -> StyledString
highlight = styled $ colored Cyan
highlight' :: String -> StyledString
highlight' = highlight
styleIncognito :: StyledFormat a => a -> StyledString
styleIncognito = styled $ colored Magenta
styleIncognito' :: String -> StyledString
styleIncognito' = styleIncognito
styleTime :: String -> StyledString
styleTime = Styled [SetColor Foreground Vivid Black]