mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-28 20:29:53 +00:00
Revert "Revert "core: rework incognito mode - set per connection (#2838)""
This reverts commit b003d659e4.
This commit is contained in:
spaced4ndy
parent
b374b5b753
commit
d80ee14f77
10 changed files with 292 additions and 120 deletions
|
|
@ -193,7 +193,6 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
|
|||
rcvFiles <- newTVarIO M.empty
|
||||
currentCalls <- atomically TM.empty
|
||||
filesFolder <- newTVarIO optFilesFolder
|
||||
incognitoMode <- newTVarIO False
|
||||
chatStoreChanged <- newTVarIO False
|
||||
expireCIThreads <- newTVarIO M.empty
|
||||
expireCIFlags <- newTVarIO M.empty
|
||||
|
|
@ -202,7 +201,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
|
|||
showLiveItems <- newTVarIO False
|
||||
userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
|
||||
tempDirectory <- newTVarIO tempDir
|
||||
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile}
|
||||
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile}
|
||||
where
|
||||
configServers :: DefaultAgentServers
|
||||
configServers =
|
||||
|
|
@ -479,9 +478,6 @@ processChatCommand = \case
|
|||
APISetXFTPConfig cfg -> do
|
||||
asks userXFTPFileConfig >>= atomically . (`writeTVar` cfg)
|
||||
ok_
|
||||
SetIncognito onOff -> do
|
||||
asks incognitoMode >>= atomically . (`writeTVar` onOff)
|
||||
ok_
|
||||
APIExportArchive cfg -> checkChatStopped $ exportArchive cfg >> ok_
|
||||
ExportArchive -> do
|
||||
ts <- liftIO getCurrentTime
|
||||
|
|
@ -936,10 +932,9 @@ processChatCommand = \case
|
|||
pure $ CRChatCleared user (AChatInfo SCTGroup $ GroupChat gInfo)
|
||||
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
|
||||
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
|
||||
APIAcceptContact connReqId -> withUser $ \_ -> withChatLock "acceptContact" $ do
|
||||
APIAcceptContact incognito connReqId -> withUser $ \_ -> withChatLock "acceptContact" $ do
|
||||
(user, cReq) <- withStore $ \db -> getContactRequest' db connReqId
|
||||
-- [incognito] generate profile to send, create connection with incognito profile
|
||||
incognito <- readTVarIO =<< asks incognitoMode
|
||||
incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
|
||||
ct <- acceptContactRequest user cReq incognitoProfile
|
||||
pure $ CRAcceptingContactRequest user ct
|
||||
|
|
@ -1251,32 +1246,45 @@ processChatCommand = \case
|
|||
EnableGroupMember gName mName -> withMemberName gName mName $ \gId mId -> APIEnableGroupMember gId mId
|
||||
ChatHelp section -> pure $ CRChatHelp section
|
||||
Welcome -> withUser $ pure . CRWelcome
|
||||
APIAddContact userId -> withUserId userId $ \user -> withChatLock "addContact" . procCmd $ do
|
||||
APIAddContact userId incognito -> withUserId userId $ \user -> 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 (aUserId user) True SCMInvitation Nothing
|
||||
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile
|
||||
toView $ CRNewContactConnection user conn
|
||||
pure $ CRInvitation user cReq
|
||||
AddContact -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIAddContact userId
|
||||
APIConnect userId (Just (ACR SCMInvitation cReq)) -> withUserId userId $ \user -> withChatLock "connect" . procCmd $ do
|
||||
pure $ CRInvitation user cReq conn
|
||||
AddContact incognito -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIAddContact userId incognito
|
||||
APISetConnectionIncognito connId incognito -> withUser $ \user@User {userId} -> do
|
||||
conn'_ <- withStore $ \db -> do
|
||||
conn@PendingContactConnection {pccConnStatus, customUserProfileId} <- getPendingContactConnection db userId connId
|
||||
case (pccConnStatus, customUserProfileId, incognito) of
|
||||
(ConnNew, Nothing, True) -> liftIO $ do
|
||||
incognitoProfile <- generateRandomProfile
|
||||
pId <- createIncognitoProfile db user incognitoProfile
|
||||
Just <$> updatePCCIncognito db user conn (Just pId)
|
||||
(ConnNew, Just pId, False) -> liftIO $ do
|
||||
deletePCCIncognitoProfile db user pId
|
||||
Just <$> updatePCCIncognito db user conn Nothing
|
||||
_ -> pure Nothing
|
||||
case conn'_ of
|
||||
Just conn' -> pure $ CRConnectionIncognitoUpdated user conn'
|
||||
Nothing -> throwChatError CEConnectionIncognitoChangeProhibited
|
||||
APIConnect userId incognito (Just (ACR SCMInvitation cReq)) -> withUserId userId $ \user -> withChatLock "connect" . procCmd $ do
|
||||
-- [incognito] generate profile to send
|
||||
incognito <- readTVarIO =<< asks incognitoMode
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
let profileToSend = userProfileToSend user incognitoProfile Nothing
|
||||
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq . directMessage $ XInfo profileToSend
|
||||
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined $ incognitoProfile $> profileToSend
|
||||
toView $ CRNewContactConnection user conn
|
||||
pure $ CRSentConfirmation user
|
||||
APIConnect userId (Just (ACR SCMContact cReq)) -> withUserId userId (`connectViaContact` cReq)
|
||||
APIConnect _ Nothing -> throwChatError CEInvalidConnReq
|
||||
Connect cReqUri -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIConnect userId cReqUri
|
||||
ConnectSimplex -> withUser $ \user ->
|
||||
APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq
|
||||
APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq
|
||||
Connect incognito cReqUri -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIConnect userId incognito cReqUri
|
||||
ConnectSimplex incognito -> withUser $ \user ->
|
||||
-- [incognito] generate profile to send
|
||||
connectViaContact user adminContactReq
|
||||
connectViaContact user incognito adminContactReq
|
||||
DeleteContact cName -> withContactName cName $ APIDeleteChat . ChatRef CTDirect
|
||||
ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect
|
||||
APIListContacts userId -> withUserId userId $ \user ->
|
||||
|
|
@ -1320,9 +1328,9 @@ processChatCommand = \case
|
|||
pure $ CRUserContactLinkUpdated user contactLink
|
||||
AddressAutoAccept autoAccept_ -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIAddressAutoAccept userId autoAccept_
|
||||
AcceptContact cName -> withUser $ \User {userId} -> do
|
||||
AcceptContact incognito cName -> withUser $ \User {userId} -> do
|
||||
connReqId <- withStore $ \db -> getContactRequestIdByName db userId cName
|
||||
processChatCommand $ APIAcceptContact connReqId
|
||||
processChatCommand $ APIAcceptContact incognito connReqId
|
||||
RejectContact cName -> withUser $ \User {userId} -> do
|
||||
connReqId <- withStore $ \db -> getContactRequestIdByName db userId cName
|
||||
processChatCommand $ APIRejectContact connReqId
|
||||
|
|
@ -1771,8 +1779,8 @@ processChatCommand = \case
|
|||
CTDirect -> withStore $ \db -> getDirectChatItemIdByText' db user cId msg
|
||||
CTGroup -> withStore $ \db -> getGroupChatItemIdByText' db user cId msg
|
||||
_ -> throwChatError $ CECommandError "not supported"
|
||||
connectViaContact :: User -> ConnectionRequestUri 'CMContact -> m ChatResponse
|
||||
connectViaContact user@User {userId} cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do
|
||||
connectViaContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> m ChatResponse
|
||||
connectViaContact user@User {userId} incognito cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do
|
||||
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
|
||||
withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case
|
||||
(Just contact, _) -> pure $ CRContactAlreadyExists user contact
|
||||
|
|
@ -1780,11 +1788,6 @@ processChatCommand = \case
|
|||
let randomXContactId = XContactId <$> drgRandomBytes 16
|
||||
xContactId <- maybe randomXContactId pure 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 = userProfileToSend user incognitoProfile Nothing
|
||||
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq $ directMessage (XContact profileToSend $ Just xContactId)
|
||||
|
|
@ -3453,7 +3456,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
|||
setActive $ ActiveG g
|
||||
showToast ("#" <> g) $ "member " <> c <> " is connected"
|
||||
|
||||
probeMatchingContacts :: Contact -> Bool -> m ()
|
||||
probeMatchingContacts :: Contact -> IncognitoEnabled -> m ()
|
||||
probeMatchingContacts ct connectedIncognito = do
|
||||
gVar <- asks idsDrg
|
||||
(probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId ct
|
||||
|
|
@ -5050,7 +5053,7 @@ chatCommandP =
|
|||
"/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP),
|
||||
"/_delete " *> (APIDeleteChat <$> chatRefP),
|
||||
"/_clear chat " *> (APIClearChat <$> chatRefP),
|
||||
"/_accept " *> (APIAcceptContact <$> A.decimal),
|
||||
"/_accept" *> (APIAcceptContact <$> incognitoOnOffP <* A.space <*> A.decimal),
|
||||
"/_reject " *> (APIRejectContact <$> A.decimal),
|
||||
"/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP),
|
||||
"/call " *> char_ '@' *> (SendCallInvitation <$> displayName <*> pure defaultCallType),
|
||||
|
|
@ -5131,6 +5134,7 @@ chatCommandP =
|
|||
("/help groups" <|> "/help group" <|> "/hg") $> ChatHelp HSGroups,
|
||||
("/help contacts" <|> "/help contact" <|> "/hc") $> ChatHelp HSContacts,
|
||||
("/help address" <|> "/ha") $> ChatHelp HSMyAddress,
|
||||
"/help incognito" $> ChatHelp HSIncognito,
|
||||
("/help messages" <|> "/hm") $> ChatHelp HSMessages,
|
||||
("/help settings" <|> "/hs") $> ChatHelp HSSettings,
|
||||
("/help db" <|> "/hd") $> ChatHelp HSDatabase,
|
||||
|
|
@ -5168,10 +5172,11 @@ chatCommandP =
|
|||
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP),
|
||||
"/_contacts " *> (APIListContacts <$> A.decimal),
|
||||
"/contacts" $> ListContacts,
|
||||
"/_connect " *> (APIConnect <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
|
||||
"/_connect " *> (APIAddContact <$> A.decimal),
|
||||
("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
|
||||
("/connect" <|> "/c") $> AddContact,
|
||||
"/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
|
||||
"/_connect " *> (APIAddContact <$> A.decimal <*> incognitoOnOffP),
|
||||
"/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP),
|
||||
("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
|
||||
("/connect" <|> "/c") *> (AddContact <$> incognitoP),
|
||||
SendMessage <$> chatNameP <* A.space <*> msgTextP,
|
||||
"/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")),
|
||||
(">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv),
|
||||
|
|
@ -5197,7 +5202,7 @@ chatCommandP =
|
|||
"/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal),
|
||||
("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal),
|
||||
("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal),
|
||||
"/simplex" $> ConnectSimplex,
|
||||
"/simplex" *> (ConnectSimplex <$> incognitoP),
|
||||
"/_address " *> (APICreateMyAddress <$> A.decimal),
|
||||
("/address" <|> "/ad") $> CreateMyAddress,
|
||||
"/_delete_address " *> (APIDeleteMyAddress <$> A.decimal),
|
||||
|
|
@ -5208,7 +5213,7 @@ chatCommandP =
|
|||
("/profile_address " <|> "/pa ") *> (SetProfileAddress <$> onOffP),
|
||||
"/_auto_accept " *> (APIAddressAutoAccept <$> A.decimal <* A.space <*> autoAcceptP),
|
||||
"/auto_accept " *> (AddressAutoAccept <$> autoAcceptP),
|
||||
("/accept " <|> "/ac ") *> char_ '@' *> (AcceptContact <$> displayName),
|
||||
("/accept" <|> "/ac") *> (AcceptContact <$> incognitoP <* A.space <* char_ '@' <*> displayName),
|
||||
("/reject " <|> "/rc ") *> char_ '@' *> (RejectContact <$> displayName),
|
||||
("/markdown" <|> "/m") $> ChatHelp HSMarkdown,
|
||||
("/welcome" <|> "/w") $> Welcome,
|
||||
|
|
@ -5230,7 +5235,7 @@ chatCommandP =
|
|||
"/set disappear #" *> (SetGroupTimedMessages <$> displayName <*> (A.space *> timedTTLOnOffP)),
|
||||
"/set disappear @" *> (SetContactTimedMessages <$> displayName <*> optional (A.space *> timedMessagesEnabledP)),
|
||||
"/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))),
|
||||
"/incognito " *> (SetIncognito <$> onOffP),
|
||||
("/incognito" <* optional (A.space *> onOffP)) $> ChatHelp HSIncognito,
|
||||
("/quit" <|> "/q" <|> "/exit") $> QuitChat,
|
||||
("/version" <|> "/v") $> ShowVersion,
|
||||
"/debug locks" $> DebugLocks,
|
||||
|
|
@ -5239,6 +5244,8 @@ chatCommandP =
|
|||
]
|
||||
where
|
||||
choice = A.choice . map (\p -> p <* A.takeWhile (== ' ') <* A.endOfInput)
|
||||
incognitoP = (A.space *> ("incognito" <|> "i")) $> True <|> pure False
|
||||
incognitoOnOffP = (A.space *> "incognito=" *> onOffP) <|> pure False
|
||||
imagePrefix = (<>) <$> "data:" <*> ("image/png;base64," <|> "image/jpg;base64,")
|
||||
imageP = safeDecodeUtf8 <$> ((<>) <$> imagePrefix <*> (B64.encode <$> base64P))
|
||||
chatTypeP = A.char '@' $> CTDirect <|> A.char '#' $> CTGroup <|> A.char ':' $> CTContactConnection
|
||||
|
|
|
|||
|
|
@ -176,7 +176,6 @@ data ChatController = ChatController
|
|||
currentCalls :: TMap ContactId Call,
|
||||
config :: ChatConfig,
|
||||
filesFolder :: TVar (Maybe FilePath), -- path to files folder for mobile apps,
|
||||
incognitoMode :: TVar Bool,
|
||||
expireCIThreads :: TMap UserId (Maybe (Async ())),
|
||||
expireCIFlags :: TMap UserId Bool,
|
||||
cleanupManagerAsync :: TVar (Maybe (Async ())),
|
||||
|
|
@ -187,7 +186,7 @@ data ChatController = ChatController
|
|||
logFilePath :: Maybe FilePath
|
||||
}
|
||||
|
||||
data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSMarkdown | HSMessages | HSSettings | HSDatabase
|
||||
data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSIncognito | HSMarkdown | HSMessages | HSSettings | HSDatabase
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON HelpSection where
|
||||
|
|
@ -223,7 +222,6 @@ data ChatCommand
|
|||
| SetTempFolder FilePath
|
||||
| SetFilesFolder FilePath
|
||||
| APISetXFTPConfig (Maybe XFTPFileConfig)
|
||||
| SetIncognito Bool
|
||||
| APIExportArchive ArchiveConfig
|
||||
| ExportArchive
|
||||
| APIImportArchive ArchiveConfig
|
||||
|
|
@ -244,7 +242,7 @@ data ChatCommand
|
|||
| APIChatUnread ChatRef Bool
|
||||
| APIDeleteChat ChatRef
|
||||
| APIClearChat ChatRef
|
||||
| APIAcceptContact Int64
|
||||
| APIAcceptContact IncognitoEnabled Int64
|
||||
| APIRejectContact Int64
|
||||
| APISendCallInvitation ContactId CallType
|
||||
| SendCallInvitation ContactName CallType
|
||||
|
|
@ -324,11 +322,12 @@ data ChatCommand
|
|||
| EnableGroupMember GroupName ContactName
|
||||
| ChatHelp HelpSection
|
||||
| Welcome
|
||||
| APIAddContact UserId
|
||||
| AddContact
|
||||
| APIConnect UserId (Maybe AConnectionRequestUri)
|
||||
| Connect (Maybe AConnectionRequestUri)
|
||||
| ConnectSimplex -- UserId (not used in UI)
|
||||
| APIAddContact UserId IncognitoEnabled
|
||||
| AddContact IncognitoEnabled
|
||||
| APISetConnectionIncognito Int64 IncognitoEnabled
|
||||
| APIConnect UserId IncognitoEnabled (Maybe AConnectionRequestUri)
|
||||
| Connect IncognitoEnabled (Maybe AConnectionRequestUri)
|
||||
| ConnectSimplex IncognitoEnabled -- UserId (not used in UI)
|
||||
| DeleteContact ContactName
|
||||
| ClearContact ContactName
|
||||
| APIListContacts UserId
|
||||
|
|
@ -343,7 +342,7 @@ data ChatCommand
|
|||
| SetProfileAddress Bool
|
||||
| APIAddressAutoAccept UserId (Maybe AutoAccept)
|
||||
| AddressAutoAccept (Maybe AutoAccept)
|
||||
| AcceptContact ContactName
|
||||
| AcceptContact IncognitoEnabled ContactName
|
||||
| RejectContact ContactName
|
||||
| SendMessage ChatName Text
|
||||
| SendLiveMessage ChatName Text
|
||||
|
|
@ -472,7 +471,8 @@ data ChatResponse
|
|||
| CRUserProfileNoChange {user :: User}
|
||||
| CRUserPrivacy {user :: User, updatedUser :: User}
|
||||
| CRVersionInfo {versionInfo :: CoreVersionInfo, chatMigrations :: [UpMigration], agentMigrations :: [UpMigration]}
|
||||
| CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation}
|
||||
| CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation, connection :: PendingContactConnection}
|
||||
| CRConnectionIncognitoUpdated {user :: User, toConnection :: PendingContactConnection}
|
||||
| CRSentConfirmation {user :: User}
|
||||
| CRSentInvitation {user :: User, customUserProfile :: Maybe Profile}
|
||||
| CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
|
||||
|
|
@ -882,6 +882,7 @@ data ChatErrorType
|
|||
| CEServerProtocol {serverProtocol :: AProtocolType}
|
||||
| CEAgentCommandError {message :: String}
|
||||
| CEInvalidFileDescription {message :: String}
|
||||
| CEConnectionIncognitoChangeProhibited
|
||||
| CEInternalError {message :: String}
|
||||
| CEException {message :: String}
|
||||
deriving (Show, Exception, Generic)
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@ module Simplex.Chat.Help
|
|||
groupsHelpInfo,
|
||||
contactsHelpInfo,
|
||||
myAddressHelpInfo,
|
||||
incognitoHelpInfo,
|
||||
messagesHelpInfo,
|
||||
markdownInfo,
|
||||
settingsInfo,
|
||||
|
|
@ -48,7 +49,7 @@ chatWelcome user =
|
|||
"Welcome " <> green userName <> "!",
|
||||
"Thank you for installing SimpleX Chat!",
|
||||
"",
|
||||
"Connect to SimpleX Chat lead developer for any questions - just type " <> highlight "/simplex",
|
||||
"Connect to SimpleX Chat developers for any questions - just type " <> highlight "/simplex",
|
||||
"",
|
||||
"Follow our updates:",
|
||||
"> Reddit: https://www.reddit.com/r/SimpleXChat/",
|
||||
|
|
@ -213,6 +214,26 @@ myAddressHelpInfo =
|
|||
"The commands may be abbreviated: " <> listHighlight ["/ad", "/da", "/sa", "/ac", "/rc"]
|
||||
]
|
||||
|
||||
incognitoHelpInfo :: [StyledString]
|
||||
incognitoHelpInfo =
|
||||
map
|
||||
styleMarkdown
|
||||
[ markdown (colored Red) "/incognito" <> " command is deprecated, use commands below instead.",
|
||||
"",
|
||||
"Incognito mode protects the privacy of your main profile — you can choose to create a new random profile for each new contact.",
|
||||
"It allows having many anonymous connections without any shared data between them in a single chat profile.",
|
||||
"When you share an incognito profile with somebody, this profile will be used for the groups they invite you to.",
|
||||
"",
|
||||
green "Incognito commands:",
|
||||
indent <> highlight "/connect incognito " <> " - create new invitation link using incognito profile",
|
||||
indent <> highlight "/connect incognito <invitation> " <> " - accept invitation using incognito profile",
|
||||
indent <> highlight "/accept incognito <name> " <> " - accept contact request using incognito profile",
|
||||
indent <> highlight "/simplex incognito " <> " - connect to SimpleX Chat developers using incognito profile",
|
||||
"",
|
||||
"The commands may be abbreviated: " <> listHighlight ["/c i", "/c i <invitation>", "/ac i <name>"],
|
||||
"To find the profile used for an incognito connection, use " <> highlight "/info <contact>" <> "."
|
||||
]
|
||||
|
||||
messagesHelpInfo :: [StyledString]
|
||||
messagesHelpInfo =
|
||||
map
|
||||
|
|
@ -269,7 +290,6 @@ settingsInfo =
|
|||
map
|
||||
styleMarkdown
|
||||
[ green "Chat settings:",
|
||||
indent <> highlight "/incognito on/off " <> " - enable/disable incognito mode",
|
||||
indent <> highlight "/network " <> " - show / set network access options",
|
||||
indent <> highlight "/smp " <> " - show / set configured SMP servers",
|
||||
indent <> highlight "/xftp " <> " - show / set configured XFTP servers",
|
||||
|
|
@ -285,12 +305,12 @@ databaseHelpInfo :: [StyledString]
|
|||
databaseHelpInfo =
|
||||
map
|
||||
styleMarkdown
|
||||
[ green "Database export:",
|
||||
indent <> highlight "/db export " <> " - create database export file that can be imported in mobile apps",
|
||||
indent <> highlight "/files_folder <path> " <> " - set files folder path to include app files in the exported archive",
|
||||
"",
|
||||
green "Database encryption:",
|
||||
indent <> highlight "/db encrypt <key> " <> " - encrypt chat database with key/passphrase",
|
||||
indent <> highlight "/db key <current> <new>" <> " - change the key of the encrypted app database",
|
||||
indent <> highlight "/db decrypt <key> " <> " - decrypt chat database"
|
||||
]
|
||||
[ green "Database export:",
|
||||
indent <> highlight "/db export " <> " - create database export file that can be imported in mobile apps",
|
||||
indent <> highlight "/files_folder <path> " <> " - set files folder path to include app files in the exported archive",
|
||||
"",
|
||||
green "Database encryption:",
|
||||
indent <> highlight "/db encrypt <key> " <> " - encrypt chat database with key/passphrase",
|
||||
indent <> highlight "/db key <current> <new>" <> " - change the key of the encrypted app database",
|
||||
indent <> highlight "/db decrypt <key> " <> " - decrypt chat database"
|
||||
]
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ module Simplex.Chat.Store.Direct
|
|||
getPendingContactConnection,
|
||||
deletePendingContactConnection,
|
||||
createDirectConnection,
|
||||
createIncognitoProfile,
|
||||
createConnReqConnection,
|
||||
getProfileById,
|
||||
getConnReqContactXContactId,
|
||||
|
|
@ -33,6 +34,8 @@ module Simplex.Chat.Store.Direct
|
|||
updateContactUserPreferences,
|
||||
updateContactAlias,
|
||||
updateContactConnectionAlias,
|
||||
updatePCCIncognito,
|
||||
deletePCCIncognitoProfile,
|
||||
updateContactUsed,
|
||||
updateContactUnreadChat,
|
||||
updateGroupUnreadChat,
|
||||
|
|
@ -171,6 +174,11 @@ createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile
|
|||
pccConnId <- insertedRowId db
|
||||
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connReqInv = Just cReq, localAlias = "", createdAt, updatedAt = createdAt}
|
||||
|
||||
createIncognitoProfile :: DB.Connection -> User -> Profile -> IO Int64
|
||||
createIncognitoProfile db User {userId} p = do
|
||||
createdAt <- getCurrentTime
|
||||
createIncognitoProfile_ db userId createdAt p
|
||||
|
||||
createIncognitoProfile_ :: DB.Connection -> UserId -> UTCTime -> Profile -> IO Int64
|
||||
createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, image} = do
|
||||
DB.execute
|
||||
|
|
@ -307,7 +315,30 @@ updateContactConnectionAlias db userId conn localAlias = do
|
|||
WHERE user_id = ? AND connection_id = ?
|
||||
|]
|
||||
(localAlias, updatedAt, userId, pccConnId conn)
|
||||
pure (conn :: PendingContactConnection) {localAlias}
|
||||
pure (conn :: PendingContactConnection) {localAlias, updatedAt}
|
||||
|
||||
updatePCCIncognito :: DB.Connection -> User -> PendingContactConnection -> Maybe ProfileId -> IO PendingContactConnection
|
||||
updatePCCIncognito db User {userId} conn customUserProfileId = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE connections
|
||||
SET custom_user_profile_id = ?, updated_at = ?
|
||||
WHERE user_id = ? AND connection_id = ?
|
||||
|]
|
||||
(customUserProfileId, updatedAt, userId, pccConnId conn)
|
||||
pure (conn :: PendingContactConnection) {customUserProfileId, updatedAt}
|
||||
|
||||
deletePCCIncognitoProfile :: DB.Connection -> User -> ProfileId -> IO ()
|
||||
deletePCCIncognitoProfile db User {userId} profileId =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
DELETE FROM contact_profiles
|
||||
WHERE user_id = ? AND contact_profile_id = ? AND incognito = 1
|
||||
|]
|
||||
(userId, profileId)
|
||||
|
||||
updateContactUsed :: DB.Connection -> User -> Contact -> IO ()
|
||||
updateContactUsed db User {userId} Contact {contactId} = do
|
||||
|
|
|
|||
|
|
@ -397,14 +397,14 @@ data UserContactLink = UserContactLink
|
|||
instance ToJSON UserContactLink where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
data AutoAccept = AutoAccept
|
||||
{ acceptIncognito :: Bool,
|
||||
{ acceptIncognito :: IncognitoEnabled,
|
||||
autoReply :: Maybe MsgContent
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON AutoAccept where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
toUserContactLink :: (ConnReqContact, Bool, Bool, Maybe MsgContent) -> UserContactLink
|
||||
toUserContactLink :: (ConnReqContact, Bool, IncognitoEnabled, Maybe MsgContent) -> UserContactLink
|
||||
toUserContactLink (connReq, autoAccept, acceptIncognito, autoReply) =
|
||||
UserContactLink connReq $
|
||||
if autoAccept then Just AutoAccept {acceptIncognito, autoReply} else Nothing
|
||||
|
|
@ -452,9 +452,6 @@ updateUserAddressAutoAccept db user@User {userId} autoAccept = do
|
|||
Just AutoAccept {acceptIncognito, autoReply} -> (True, acceptIncognito, autoReply)
|
||||
_ -> (False, False, Nothing)
|
||||
|
||||
|
||||
|
||||
|
||||
getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> IO [ServerCfg p]
|
||||
getProtocolServers db User {userId} =
|
||||
map toServerCfg
|
||||
|
|
|
|||
|
|
@ -203,7 +203,7 @@ createContact_ db userId connId Profile {displayName, fullName, image, contactLi
|
|||
pure $ Right (ldn, contactId, profileId)
|
||||
|
||||
deleteUnusedIncognitoProfileById_ :: DB.Connection -> User -> ProfileId -> IO ()
|
||||
deleteUnusedIncognitoProfileById_ db User {userId} profile_id =
|
||||
deleteUnusedIncognitoProfileById_ db User {userId} profileId =
|
||||
DB.executeNamed
|
||||
db
|
||||
[sql|
|
||||
|
|
@ -218,7 +218,7 @@ deleteUnusedIncognitoProfileById_ db User {userId} profile_id =
|
|||
WHERE user_id = :user_id AND member_profile_id = :profile_id LIMIT 1
|
||||
)
|
||||
|]
|
||||
[":user_id" := userId, ":profile_id" := profile_id]
|
||||
[":user_id" := userId, ":profile_id" := profileId]
|
||||
|
||||
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)
|
||||
|
||||
|
|
|
|||
|
|
@ -184,7 +184,9 @@ contactConn = activeConn
|
|||
contactConnId :: Contact -> ConnId
|
||||
contactConnId = aConnId . contactConn
|
||||
|
||||
contactConnIncognito :: Contact -> Bool
|
||||
type IncognitoEnabled = Bool
|
||||
|
||||
contactConnIncognito :: Contact -> IncognitoEnabled
|
||||
contactConnIncognito = connIncognito . contactConn
|
||||
|
||||
contactDirect :: Contact -> Bool
|
||||
|
|
@ -602,7 +604,7 @@ memberConnId GroupMember {activeConn} = aConnId <$> activeConn
|
|||
groupMemberId' :: GroupMember -> GroupMemberId
|
||||
groupMemberId' GroupMember {groupMemberId} = groupMemberId
|
||||
|
||||
memberIncognito :: GroupMember -> Bool
|
||||
memberIncognito :: GroupMember -> IncognitoEnabled
|
||||
memberIncognito GroupMember {memberProfile, memberContactProfileId} = localProfileId memberProfile /= memberContactProfileId
|
||||
|
||||
memberSecurityCode :: GroupMember -> Maybe SecurityCode
|
||||
|
|
|
|||
|
|
@ -116,6 +116,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
|
|||
HSGroups -> groupsHelpInfo
|
||||
HSContacts -> contactsHelpInfo
|
||||
HSMyAddress -> myAddressHelpInfo
|
||||
HSIncognito -> incognitoHelpInfo
|
||||
HSMessages -> messagesHelpInfo
|
||||
HSMarkdown -> markdownInfo
|
||||
HSSettings -> settingsInfo
|
||||
|
|
@ -139,7 +140,8 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
|
|||
CRUserProfileNoChange u -> ttyUser u ["user profile did not change"]
|
||||
CRUserPrivacy u u' -> ttyUserPrefix u $ viewUserPrivacy u u'
|
||||
CRVersionInfo info _ _ -> viewVersionInfo logLevel info
|
||||
CRInvitation u cReq -> ttyUser u $ viewConnReqInvitation cReq
|
||||
CRInvitation u cReq _ -> ttyUser u $ viewConnReqInvitation cReq
|
||||
CRConnectionIncognitoUpdated u c -> ttyUser u $ viewConnectionIncognitoUpdated c
|
||||
CRSentConfirmation u -> ttyUser u ["confirmation sent!"]
|
||||
CRSentInvitation u customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
|
||||
CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"]
|
||||
|
|
@ -1161,6 +1163,11 @@ viewConnectionAliasUpdated PendingContactConnection {pccConnId, localAlias}
|
|||
| localAlias == "" = ["connection " <> sShow pccConnId <> " alias removed"]
|
||||
| otherwise = ["connection " <> sShow pccConnId <> " alias updated: " <> plain localAlias]
|
||||
|
||||
viewConnectionIncognitoUpdated :: PendingContactConnection -> [StyledString]
|
||||
viewConnectionIncognitoUpdated PendingContactConnection {pccConnId, customUserProfileId}
|
||||
| isJust customUserProfileId = ["connection " <> sShow pccConnId <> " changed to incognito"]
|
||||
| otherwise = ["connection " <> sShow pccConnId <> " changed to non incognito"]
|
||||
|
||||
viewContactUpdated :: Contact -> Contact -> [StyledString]
|
||||
viewContactUpdated
|
||||
Contact {localDisplayName = n, profile = LocalProfile {fullName, contactLink}}
|
||||
|
|
@ -1552,6 +1559,7 @@ viewChatError logLevel = \case
|
|||
CECommandError e -> ["bad chat command: " <> plain e]
|
||||
CEAgentCommandError e -> ["agent command error: " <> plain e]
|
||||
CEInvalidFileDescription e -> ["invalid file description: " <> plain e]
|
||||
CEConnectionIncognitoChangeProhibited -> ["incognito mode change prohibited"]
|
||||
CEInternalError e -> ["internal chat error: " <> plain e]
|
||||
CEException e -> ["exception: " <> plain e]
|
||||
-- e -> ["chat error: " <> sShow e]
|
||||
|
|
|
|||
|
|
@ -1817,8 +1817,7 @@ testGroupLinkIncognitoMembership =
|
|||
-- bob connected incognito to alice
|
||||
alice ##> "/c"
|
||||
inv <- getInvitation alice
|
||||
bob #$> ("/incognito on", id, "ok")
|
||||
bob ##> ("/c " <> inv)
|
||||
bob ##> ("/c i " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
bobIncognito <- getTermLine bob
|
||||
concurrentlyN_
|
||||
|
|
@ -1827,7 +1826,6 @@ testGroupLinkIncognitoMembership =
|
|||
bob <## "use /i alice to print out this incognito profile again",
|
||||
alice <## (bobIncognito <> ": contact is connected")
|
||||
]
|
||||
bob #$> ("/incognito off", id, "ok")
|
||||
-- alice creates group
|
||||
alice ##> "/g team"
|
||||
alice <## "group #team is created"
|
||||
|
|
@ -1870,8 +1868,7 @@ testGroupLinkIncognitoMembership =
|
|||
cath #> ("@" <> bobIncognito <> " hey, I'm cath")
|
||||
bob ?<# "cath> hey, I'm cath"
|
||||
-- dan joins incognito
|
||||
dan #$> ("/incognito on", id, "ok")
|
||||
dan ##> ("/c " <> gLink)
|
||||
dan ##> ("/c i " <> gLink)
|
||||
danIncognito <- getTermLine dan
|
||||
dan <## "connection request sent incognito!"
|
||||
bob <## (danIncognito <> ": accepting request to join group #team...")
|
||||
|
|
@ -1898,7 +1895,6 @@ testGroupLinkIncognitoMembership =
|
|||
cath <## ("#team: " <> bobIncognito <> " added " <> danIncognito <> " to the group (connecting...)")
|
||||
cath <## ("#team: new member " <> danIncognito <> " is connected")
|
||||
]
|
||||
dan #$> ("/incognito off", id, "ok")
|
||||
bob ?#> ("@" <> danIncognito <> " hi, I'm incognito")
|
||||
dan ?<# (bobIncognito <> "> hi, I'm incognito")
|
||||
dan ?#> ("@" <> bobIncognito <> " hey, me too")
|
||||
|
|
@ -2006,7 +2002,6 @@ testGroupLinkIncognitoUnusedHostContactsDeleted :: HasCallStack => FilePath -> I
|
|||
testGroupLinkIncognitoUnusedHostContactsDeleted =
|
||||
testChatCfg2 cfg aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
bob #$> ("/incognito on", id, "ok")
|
||||
bobIncognitoTeam <- createGroupBobIncognito alice bob "team" "alice"
|
||||
bobIncognitoClub <- createGroupBobIncognito alice bob "club" "alice_1"
|
||||
bobIncognitoTeam `shouldNotBe` bobIncognitoClub
|
||||
|
|
@ -2036,7 +2031,7 @@ testGroupLinkIncognitoUnusedHostContactsDeleted =
|
|||
alice <## ("to add members use /a " <> group <> " <name> or /create link #" <> group)
|
||||
alice ##> ("/create link #" <> group)
|
||||
gLinkTeam <- getGroupLink alice group GRMember True
|
||||
bob ##> ("/c " <> gLinkTeam)
|
||||
bob ##> ("/c i " <> gLinkTeam)
|
||||
bobIncognito <- getTermLine bob
|
||||
bob <## "connection request sent incognito!"
|
||||
alice <## (bobIncognito <> ": accepting request to join group #" <> group <> "...")
|
||||
|
|
|
|||
|
|
@ -27,10 +27,15 @@ chatProfileTests = do
|
|||
it "delete connection requests when contact link deleted" testDeleteConnectionRequests
|
||||
it "auto-reply message" testAutoReplyMessage
|
||||
it "auto-reply message in incognito" testAutoReplyMessageInIncognito
|
||||
describe "incognito mode" $ do
|
||||
describe "incognito" $ do
|
||||
it "connect incognito via invitation link" testConnectIncognitoInvitationLink
|
||||
it "connect incognito via contact address" testConnectIncognitoContactAddress
|
||||
it "accept contact request incognito" testAcceptContactRequestIncognito
|
||||
it "set connection incognito" testSetConnectionIncognito
|
||||
it "reset connection incognito" testResetConnectionIncognito
|
||||
it "set connection incognito prohibited during negotiation" testSetConnectionIncognitoProhibitedDuringNegotiation
|
||||
it "connection incognito unchanged errors" testConnectionIncognitoUnchangedErrors
|
||||
it "set, reset, set connection incognito" testSetResetSetConnectionIncognito
|
||||
it "join group incognito" testJoinGroupIncognito
|
||||
it "can't invite contact to whom user connected incognito to a group" testCantInviteContactIncognito
|
||||
it "can't see global preferences update" testCantSeeGlobalPrefsUpdateIncognito
|
||||
|
|
@ -489,11 +494,9 @@ testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $
|
|||
testConnectIncognitoInvitationLink :: HasCallStack => FilePath -> IO ()
|
||||
testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice #$> ("/incognito on", id, "ok")
|
||||
bob #$> ("/incognito on", id, "ok")
|
||||
alice ##> "/c"
|
||||
alice ##> "/connect incognito"
|
||||
inv <- getInvitation alice
|
||||
bob ##> ("/c " <> inv)
|
||||
bob ##> ("/connect incognito " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
bobIncognito <- getTermLine bob
|
||||
aliceIncognito <- getTermLine alice
|
||||
|
|
@ -505,9 +508,6 @@ testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfi
|
|||
alice <## (bobIncognito <> ": contact is connected, your incognito profile for this contact is " <> aliceIncognito)
|
||||
alice <## ("use /i " <> bobIncognito <> " to print out this incognito profile again")
|
||||
]
|
||||
-- after turning incognito mode off conversation is incognito
|
||||
alice #$> ("/incognito off", id, "ok")
|
||||
bob #$> ("/incognito off", id, "ok")
|
||||
alice ?#> ("@" <> bobIncognito <> " psst, I'm incognito")
|
||||
bob ?<# (aliceIncognito <> "> psst, I'm incognito")
|
||||
bob ?#> ("@" <> aliceIncognito <> " <whispering> me too")
|
||||
|
|
@ -569,8 +569,7 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
|
|||
\alice bob -> do
|
||||
alice ##> "/ad"
|
||||
cLink <- getContactLink alice True
|
||||
bob #$> ("/incognito on", id, "ok")
|
||||
bob ##> ("/c " <> cLink)
|
||||
bob ##> ("/c i " <> cLink)
|
||||
bobIncognito <- getTermLine bob
|
||||
bob <## "connection request sent incognito!"
|
||||
alice <## (bobIncognito <> " wants to connect to you!")
|
||||
|
|
@ -585,9 +584,7 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
|
|||
bob <## "use /i alice to print out this incognito profile again",
|
||||
alice <## (bobIncognito <> ": contact is connected")
|
||||
]
|
||||
-- after turning incognito mode off conversation is incognito
|
||||
alice #$> ("/incognito off", id, "ok")
|
||||
bob #$> ("/incognito off", id, "ok")
|
||||
-- conversation is incognito
|
||||
alice #> ("@" <> bobIncognito <> " who are you?")
|
||||
bob ?<# "alice> who are you?"
|
||||
bob ?#> "@alice I'm Batman"
|
||||
|
|
@ -605,39 +602,162 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
|
|||
bob `hasContactProfiles` ["bob"]
|
||||
|
||||
testAcceptContactRequestIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testAcceptContactRequestIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
testAcceptContactRequestIncognito = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice ##> "/ad"
|
||||
cLink <- getContactLink alice True
|
||||
bob ##> ("/c " <> cLink)
|
||||
alice <#? bob
|
||||
alice #$> ("/incognito on", id, "ok")
|
||||
alice ##> "/ac bob"
|
||||
alice ##> "/accept incognito bob"
|
||||
alice <## "bob (Bob): accepting contact request..."
|
||||
aliceIncognito <- getTermLine alice
|
||||
aliceIncognitoBob <- getTermLine alice
|
||||
concurrentlyN_
|
||||
[ bob <## (aliceIncognito <> ": contact is connected"),
|
||||
[ bob <## (aliceIncognitoBob <> ": contact is connected"),
|
||||
do
|
||||
alice <## ("bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito)
|
||||
alice <## ("bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognitoBob)
|
||||
alice <## "use /i bob to print out this incognito profile again"
|
||||
]
|
||||
-- after turning incognito mode off conversation is incognito
|
||||
alice #$> ("/incognito off", id, "ok")
|
||||
bob #$> ("/incognito off", id, "ok")
|
||||
-- conversation is incognito
|
||||
alice ?#> "@bob my profile is totally inconspicuous"
|
||||
bob <# (aliceIncognito <> "> my profile is totally inconspicuous")
|
||||
bob #> ("@" <> aliceIncognito <> " I know!")
|
||||
bob <# (aliceIncognitoBob <> "> my profile is totally inconspicuous")
|
||||
bob #> ("@" <> aliceIncognitoBob <> " I know!")
|
||||
alice ?<# "bob> I know!"
|
||||
-- list contacts
|
||||
alice ##> "/contacts"
|
||||
alice <## "i bob (Bob)"
|
||||
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito]
|
||||
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognitoBob]
|
||||
-- delete contact, incognito profile is deleted
|
||||
alice ##> "/d bob"
|
||||
alice <## "bob: contact is deleted"
|
||||
alice ##> "/contacts"
|
||||
(alice </)
|
||||
alice `hasContactProfiles` ["alice"]
|
||||
-- /_accept api
|
||||
cath ##> ("/c " <> cLink)
|
||||
alice <#? cath
|
||||
alice ##> "/_accept incognito=on 1"
|
||||
alice <## "cath (Catherine): accepting contact request..."
|
||||
aliceIncognitoCath <- getTermLine alice
|
||||
concurrentlyN_
|
||||
[ cath <## (aliceIncognitoCath <> ": contact is connected"),
|
||||
do
|
||||
alice <## ("cath (Catherine): contact is connected, your incognito profile for this contact is " <> aliceIncognitoCath)
|
||||
alice <## "use /i cath to print out this incognito profile again"
|
||||
]
|
||||
alice `hasContactProfiles` ["alice", "cath", T.pack aliceIncognitoCath]
|
||||
cath `hasContactProfiles` ["cath", T.pack aliceIncognitoCath]
|
||||
|
||||
testSetConnectionIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testSetConnectionIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/connect"
|
||||
inv <- getInvitation alice
|
||||
alice ##> "/_set incognito :1 on"
|
||||
alice <## "connection 1 changed to incognito"
|
||||
bob ##> ("/connect " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
aliceIncognito <- getTermLine alice
|
||||
concurrentlyN_
|
||||
[ bob <## (aliceIncognito <> ": contact is connected"),
|
||||
do
|
||||
alice <## ("bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito)
|
||||
alice <## ("use /i bob to print out this incognito profile again")
|
||||
]
|
||||
alice ?#> ("@bob hi")
|
||||
bob <# (aliceIncognito <> "> hi")
|
||||
bob #> ("@" <> aliceIncognito <> " hey")
|
||||
alice ?<# ("bob> hey")
|
||||
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito]
|
||||
bob `hasContactProfiles` ["bob", T.pack aliceIncognito]
|
||||
|
||||
testResetConnectionIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testResetConnectionIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/_connect 1 incognito=on"
|
||||
inv <- getInvitation alice
|
||||
alice ##> "/_set incognito :1 off"
|
||||
alice <## "connection 1 changed to non incognito"
|
||||
bob ##> ("/c " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
concurrently_
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
alice <##> bob
|
||||
alice `hasContactProfiles` ["alice", "bob"]
|
||||
bob `hasContactProfiles` ["alice", "bob"]
|
||||
|
||||
testSetConnectionIncognitoProhibitedDuringNegotiation :: HasCallStack => FilePath -> IO ()
|
||||
testSetConnectionIncognitoProhibitedDuringNegotiation tmp = do
|
||||
inv <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
threadDelay 250000
|
||||
alice ##> "/connect"
|
||||
getInvitation alice
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
||||
threadDelay 250000
|
||||
bob ##> ("/c " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
withTestChat tmp "alice" $ \alice -> do
|
||||
threadDelay 250000
|
||||
alice ##> "/_set incognito :1 on"
|
||||
alice <## "chat db error: SEPendingConnectionNotFound {connId = 1}"
|
||||
withTestChat tmp "bob" $ \bob -> do
|
||||
concurrently_
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
alice <##> bob
|
||||
alice `hasContactProfiles` ["alice", "bob"]
|
||||
bob `hasContactProfiles` ["alice", "bob"]
|
||||
|
||||
testConnectionIncognitoUnchangedErrors :: HasCallStack => FilePath -> IO ()
|
||||
testConnectionIncognitoUnchangedErrors = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/connect"
|
||||
inv <- getInvitation alice
|
||||
alice ##> "/_set incognito :1 off"
|
||||
alice <## "incognito mode change prohibited"
|
||||
alice ##> "/_set incognito :1 on"
|
||||
alice <## "connection 1 changed to incognito"
|
||||
alice ##> "/_set incognito :1 on"
|
||||
alice <## "incognito mode change prohibited"
|
||||
alice ##> "/_set incognito :1 off"
|
||||
alice <## "connection 1 changed to non incognito"
|
||||
alice ##> "/_set incognito :1 off"
|
||||
alice <## "incognito mode change prohibited"
|
||||
bob ##> ("/c " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
concurrently_
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
alice <##> bob
|
||||
alice `hasContactProfiles` ["alice", "bob"]
|
||||
bob `hasContactProfiles` ["alice", "bob"]
|
||||
|
||||
testSetResetSetConnectionIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testSetResetSetConnectionIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/_connect 1 incognito=off"
|
||||
inv <- getInvitation alice
|
||||
alice ##> "/_set incognito :1 on"
|
||||
alice <## "connection 1 changed to incognito"
|
||||
alice ##> "/_set incognito :1 off"
|
||||
alice <## "connection 1 changed to non incognito"
|
||||
alice ##> "/_set incognito :1 on"
|
||||
alice <## "connection 1 changed to incognito"
|
||||
bob ##> ("/_connect 1 incognito=off " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
aliceIncognito <- getTermLine alice
|
||||
concurrentlyN_
|
||||
[ bob <## (aliceIncognito <> ": contact is connected"),
|
||||
do
|
||||
alice <## ("bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito)
|
||||
alice <## ("use /i bob to print out this incognito profile again")
|
||||
]
|
||||
alice ?#> ("@bob hi")
|
||||
bob <# (aliceIncognito <> "> hi")
|
||||
bob #> ("@" <> aliceIncognito <> " hey")
|
||||
alice ?<# ("bob> hey")
|
||||
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito]
|
||||
bob `hasContactProfiles` ["bob", T.pack aliceIncognito]
|
||||
|
||||
testJoinGroupIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfile $
|
||||
|
|
@ -651,8 +771,7 @@ testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfil
|
|||
-- cath connected incognito to alice
|
||||
alice ##> "/c"
|
||||
inv <- getInvitation alice
|
||||
cath #$> ("/incognito on", id, "ok")
|
||||
cath ##> ("/c " <> inv)
|
||||
cath ##> ("/c i " <> inv)
|
||||
cath <## "confirmation sent!"
|
||||
cathIncognito <- getTermLine cath
|
||||
concurrentlyN_
|
||||
|
|
@ -685,10 +804,8 @@ testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfil
|
|||
cath <## "#secret_club: alice invites you to join the group as admin"
|
||||
cath <## ("use /j secret_club to join incognito as " <> cathIncognito)
|
||||
]
|
||||
-- cath uses the same incognito profile when joining group, disabling incognito mode doesn't affect it
|
||||
cath #$> ("/incognito off", id, "ok")
|
||||
-- cath uses the same incognito profile when joining group, cath and bob don't merge contacts
|
||||
cath ##> "/j secret_club"
|
||||
-- cath and bob don't merge contacts
|
||||
concurrentlyN_
|
||||
[ alice <## ("#secret_club: " <> cathIncognito <> " joined the group"),
|
||||
do
|
||||
|
|
@ -834,8 +951,7 @@ testCantInviteContactIncognito :: HasCallStack => FilePath -> IO ()
|
|||
testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
-- alice connected incognito to bob
|
||||
alice #$> ("/incognito on", id, "ok")
|
||||
alice ##> "/c"
|
||||
alice ##> "/c i"
|
||||
inv <- getInvitation alice
|
||||
bob ##> ("/c " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
|
|
@ -847,7 +963,6 @@ testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
|
|||
alice <## "use /i bob to print out this incognito profile again"
|
||||
]
|
||||
-- alice creates group non incognito
|
||||
alice #$> ("/incognito off", id, "ok")
|
||||
alice ##> "/g club"
|
||||
alice <## "group #club is created"
|
||||
alice <## "to add members use /a club <name> or /create link #club"
|
||||
|
|
@ -859,10 +974,8 @@ testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
|
|||
testCantSeeGlobalPrefsUpdateIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice #$> ("/incognito on", id, "ok")
|
||||
alice ##> "/c"
|
||||
alice ##> "/c i"
|
||||
invIncognito <- getInvitation alice
|
||||
alice #$> ("/incognito off", id, "ok")
|
||||
alice ##> "/c"
|
||||
inv <- getInvitation alice
|
||||
bob ##> ("/c " <> invIncognito)
|
||||
|
|
@ -915,8 +1028,7 @@ testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobPr
|
|||
-- bob connects incognito to alice
|
||||
alice ##> "/c"
|
||||
inv <- getInvitation alice
|
||||
bob #$> ("/incognito on", id, "ok")
|
||||
bob ##> ("/c " <> inv)
|
||||
bob ##> ("/c i " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
bobIncognito <- getTermLine bob
|
||||
concurrentlyN_
|
||||
|
|
@ -967,8 +1079,7 @@ testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobPr
|
|||
-- bob connects incognito to alice
|
||||
alice ##> "/c"
|
||||
inv <- getInvitation alice
|
||||
bob #$> ("/incognito on", id, "ok")
|
||||
bob ##> ("/c " <> inv)
|
||||
bob ##> ("/c i " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
bobIncognito <- getTermLine bob
|
||||
concurrentlyN_
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue