Revert "core: rework incognito mode - set per connection (#2838)"

This reverts commit 4e27a4ea4f.
This commit is contained in:
Evgeny Poberezkin 2023-08-04 16:55:55 +01:00
parent 6d113ae2e2
commit b003d659e4
10 changed files with 120 additions and 292 deletions

View File

@ -193,6 +193,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
rcvFiles <- newTVarIO M.empty rcvFiles <- newTVarIO M.empty
currentCalls <- atomically TM.empty currentCalls <- atomically TM.empty
filesFolder <- newTVarIO optFilesFolder filesFolder <- newTVarIO optFilesFolder
incognitoMode <- newTVarIO False
chatStoreChanged <- newTVarIO False chatStoreChanged <- newTVarIO False
expireCIThreads <- newTVarIO M.empty expireCIThreads <- newTVarIO M.empty
expireCIFlags <- newTVarIO M.empty expireCIFlags <- newTVarIO M.empty
@ -201,7 +202,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
showLiveItems <- newTVarIO False showLiveItems <- newTVarIO False
userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
tempDirectory <- newTVarIO tempDir tempDirectory <- newTVarIO tempDir
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} 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}
where where
configServers :: DefaultAgentServers configServers :: DefaultAgentServers
configServers = configServers =
@ -472,6 +473,9 @@ processChatCommand = \case
APISetXFTPConfig cfg -> do APISetXFTPConfig cfg -> do
asks userXFTPFileConfig >>= atomically . (`writeTVar` cfg) asks userXFTPFileConfig >>= atomically . (`writeTVar` cfg)
ok_ ok_
SetIncognito onOff -> do
asks incognitoMode >>= atomically . (`writeTVar` onOff)
ok_
APIExportArchive cfg -> checkChatStopped $ exportArchive cfg >> ok_ APIExportArchive cfg -> checkChatStopped $ exportArchive cfg >> ok_
ExportArchive -> do ExportArchive -> do
ts <- liftIO getCurrentTime ts <- liftIO getCurrentTime
@ -926,9 +930,10 @@ processChatCommand = \case
pure $ CRChatCleared user (AChatInfo SCTGroup $ GroupChat gInfo) pure $ CRChatCleared user (AChatInfo SCTGroup $ GroupChat gInfo)
CTContactConnection -> pure $ chatCmdError (Just user) "not supported" CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
APIAcceptContact incognito connReqId -> withUser $ \_ -> withChatLock "acceptContact" $ do APIAcceptContact connReqId -> withUser $ \_ -> withChatLock "acceptContact" $ do
(user, cReq) <- withStore $ \db -> getContactRequest' db connReqId (user, cReq) <- withStore $ \db -> getContactRequest' db connReqId
-- [incognito] generate profile to send, create connection with incognito profile -- [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 incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
ct <- acceptContactRequest user cReq incognitoProfile ct <- acceptContactRequest user cReq incognitoProfile
pure $ CRAcceptingContactRequest user ct pure $ CRAcceptingContactRequest user ct
@ -1234,45 +1239,32 @@ processChatCommand = \case
EnableGroupMember gName mName -> withMemberName gName mName $ \gId mId -> APIEnableGroupMember gId mId EnableGroupMember gName mName -> withMemberName gName mName $ \gId mId -> APIEnableGroupMember gId mId
ChatHelp section -> pure $ CRChatHelp section ChatHelp section -> pure $ CRChatHelp section
Welcome -> withUser $ pure . CRWelcome Welcome -> withUser $ pure . CRWelcome
APIAddContact userId incognito -> withUserId userId $ \user -> withChatLock "addContact" . procCmd $ do APIAddContact userId -> withUserId userId $ \user -> withChatLock "addContact" . procCmd $ do
-- [incognito] generate profile for connection -- [incognito] generate profile for connection
incognito <- readTVarIO =<< asks incognitoMode
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile
toView $ CRNewContactConnection user conn toView $ CRNewContactConnection user conn
pure $ CRInvitation user cReq conn pure $ CRInvitation user cReq
AddContact incognito -> withUser $ \User {userId} -> AddContact -> withUser $ \User {userId} ->
processChatCommand $ APIAddContact userId incognito processChatCommand $ APIAddContact userId
APISetConnectionIncognito connId incognito -> withUser $ \user@User {userId} -> do APIConnect userId (Just (ACR SCMInvitation cReq)) -> withUserId userId $ \user -> withChatLock "connect" . procCmd $ 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] generate profile to send
incognito <- readTVarIO =<< asks incognitoMode
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = userProfileToSend user incognitoProfile Nothing let profileToSend = userProfileToSend user incognitoProfile Nothing
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq . directMessage $ XInfo profileToSend connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq . directMessage $ XInfo profileToSend
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined $ incognitoProfile $> profileToSend conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined $ incognitoProfile $> profileToSend
toView $ CRNewContactConnection user conn toView $ CRNewContactConnection user conn
pure $ CRSentConfirmation user pure $ CRSentConfirmation user
APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq APIConnect userId (Just (ACR SCMContact cReq)) -> withUserId userId (`connectViaContact` cReq)
APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq APIConnect _ Nothing -> throwChatError CEInvalidConnReq
Connect incognito cReqUri -> withUser $ \User {userId} -> Connect cReqUri -> withUser $ \User {userId} ->
processChatCommand $ APIConnect userId incognito cReqUri processChatCommand $ APIConnect userId cReqUri
ConnectSimplex incognito -> withUser $ \user -> ConnectSimplex -> withUser $ \user ->
-- [incognito] generate profile to send -- [incognito] generate profile to send
connectViaContact user incognito adminContactReq connectViaContact user adminContactReq
DeleteContact cName -> withContactName cName $ APIDeleteChat . ChatRef CTDirect DeleteContact cName -> withContactName cName $ APIDeleteChat . ChatRef CTDirect
ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect
APIListContacts userId -> withUserId userId $ \user -> APIListContacts userId -> withUserId userId $ \user ->
@ -1316,9 +1308,9 @@ processChatCommand = \case
pure $ CRUserContactLinkUpdated user contactLink pure $ CRUserContactLinkUpdated user contactLink
AddressAutoAccept autoAccept_ -> withUser $ \User {userId} -> AddressAutoAccept autoAccept_ -> withUser $ \User {userId} ->
processChatCommand $ APIAddressAutoAccept userId autoAccept_ processChatCommand $ APIAddressAutoAccept userId autoAccept_
AcceptContact incognito cName -> withUser $ \User {userId} -> do AcceptContact cName -> withUser $ \User {userId} -> do
connReqId <- withStore $ \db -> getContactRequestIdByName db userId cName connReqId <- withStore $ \db -> getContactRequestIdByName db userId cName
processChatCommand $ APIAcceptContact incognito connReqId processChatCommand $ APIAcceptContact connReqId
RejectContact cName -> withUser $ \User {userId} -> do RejectContact cName -> withUser $ \User {userId} -> do
connReqId <- withStore $ \db -> getContactRequestIdByName db userId cName connReqId <- withStore $ \db -> getContactRequestIdByName db userId cName
processChatCommand $ APIRejectContact connReqId processChatCommand $ APIRejectContact connReqId
@ -1762,8 +1754,8 @@ processChatCommand = \case
CTDirect -> withStore $ \db -> getDirectChatItemIdByText' db user cId msg CTDirect -> withStore $ \db -> getDirectChatItemIdByText' db user cId msg
CTGroup -> withStore $ \db -> getGroupChatItemIdByText' db user cId msg CTGroup -> withStore $ \db -> getGroupChatItemIdByText' db user cId msg
_ -> throwChatError $ CECommandError "not supported" _ -> throwChatError $ CECommandError "not supported"
connectViaContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> m ChatResponse connectViaContact :: User -> ConnectionRequestUri 'CMContact -> m ChatResponse
connectViaContact user@User {userId} incognito cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do connectViaContact user@User {userId} cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case
(Just contact, _) -> pure $ CRContactAlreadyExists user contact (Just contact, _) -> pure $ CRContactAlreadyExists user contact
@ -1771,6 +1763,11 @@ processChatCommand = \case
let randomXContactId = XContactId <$> drgRandomBytes 16 let randomXContactId = XContactId <$> drgRandomBytes 16
xContactId <- maybe randomXContactId pure xContactId_ xContactId <- maybe randomXContactId pure xContactId_
-- [incognito] generate profile to send -- [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 incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = userProfileToSend user incognitoProfile Nothing let profileToSend = userProfileToSend user incognitoProfile Nothing
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq $ directMessage (XContact profileToSend $ Just xContactId) connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq $ directMessage (XContact profileToSend $ Just xContactId)
@ -3439,7 +3436,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
setActive $ ActiveG g setActive $ ActiveG g
showToast ("#" <> g) $ "member " <> c <> " is connected" showToast ("#" <> g) $ "member " <> c <> " is connected"
probeMatchingContacts :: Contact -> IncognitoEnabled -> m () probeMatchingContacts :: Contact -> Bool -> m ()
probeMatchingContacts ct connectedIncognito = do probeMatchingContacts ct connectedIncognito = do
gVar <- asks idsDrg gVar <- asks idsDrg
(probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId ct (probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId ct
@ -5036,7 +5033,7 @@ chatCommandP =
"/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP), "/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP),
"/_delete " *> (APIDeleteChat <$> chatRefP), "/_delete " *> (APIDeleteChat <$> chatRefP),
"/_clear chat " *> (APIClearChat <$> chatRefP), "/_clear chat " *> (APIClearChat <$> chatRefP),
"/_accept" *> (APIAcceptContact <$> incognitoOnOffP <* A.space <*> A.decimal), "/_accept " *> (APIAcceptContact <$> A.decimal),
"/_reject " *> (APIRejectContact <$> A.decimal), "/_reject " *> (APIRejectContact <$> A.decimal),
"/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP), "/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP),
"/call " *> char_ '@' *> (SendCallInvitation <$> displayName <*> pure defaultCallType), "/call " *> char_ '@' *> (SendCallInvitation <$> displayName <*> pure defaultCallType),
@ -5115,7 +5112,6 @@ chatCommandP =
("/help groups" <|> "/help group" <|> "/hg") $> ChatHelp HSGroups, ("/help groups" <|> "/help group" <|> "/hg") $> ChatHelp HSGroups,
("/help contacts" <|> "/help contact" <|> "/hc") $> ChatHelp HSContacts, ("/help contacts" <|> "/help contact" <|> "/hc") $> ChatHelp HSContacts,
("/help address" <|> "/ha") $> ChatHelp HSMyAddress, ("/help address" <|> "/ha") $> ChatHelp HSMyAddress,
"/help incognito" $> ChatHelp HSIncognito,
("/help messages" <|> "/hm") $> ChatHelp HSMessages, ("/help messages" <|> "/hm") $> ChatHelp HSMessages,
("/help settings" <|> "/hs") $> ChatHelp HSSettings, ("/help settings" <|> "/hs") $> ChatHelp HSSettings,
("/help db" <|> "/hd") $> ChatHelp HSDatabase, ("/help db" <|> "/hd") $> ChatHelp HSDatabase,
@ -5149,11 +5145,10 @@ chatCommandP =
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP), (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP),
"/_contacts " *> (APIListContacts <$> A.decimal), "/_contacts " *> (APIListContacts <$> A.decimal),
"/contacts" $> ListContacts, "/contacts" $> ListContacts,
"/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)), "/_connect " *> (APIConnect <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
"/_connect " *> (APIAddContact <$> A.decimal <*> incognitoOnOffP), "/_connect " *> (APIAddContact <$> A.decimal),
"/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP), ("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)), ("/connect" <|> "/c") $> AddContact,
("/connect" <|> "/c") *> (AddContact <$> incognitoP),
SendMessage <$> chatNameP <* A.space <*> msgTextP, SendMessage <$> chatNameP <* A.space <*> msgTextP,
"/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")), "/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")),
(">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv), (">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv),
@ -5179,7 +5174,7 @@ chatCommandP =
"/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal), "/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal),
("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal), ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal),
("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal), ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal),
"/simplex" *> (ConnectSimplex <$> incognitoP), "/simplex" $> ConnectSimplex,
"/_address " *> (APICreateMyAddress <$> A.decimal), "/_address " *> (APICreateMyAddress <$> A.decimal),
("/address" <|> "/ad") $> CreateMyAddress, ("/address" <|> "/ad") $> CreateMyAddress,
"/_delete_address " *> (APIDeleteMyAddress <$> A.decimal), "/_delete_address " *> (APIDeleteMyAddress <$> A.decimal),
@ -5190,7 +5185,7 @@ chatCommandP =
("/profile_address " <|> "/pa ") *> (SetProfileAddress <$> onOffP), ("/profile_address " <|> "/pa ") *> (SetProfileAddress <$> onOffP),
"/_auto_accept " *> (APIAddressAutoAccept <$> A.decimal <* A.space <*> autoAcceptP), "/_auto_accept " *> (APIAddressAutoAccept <$> A.decimal <* A.space <*> autoAcceptP),
"/auto_accept " *> (AddressAutoAccept <$> autoAcceptP), "/auto_accept " *> (AddressAutoAccept <$> autoAcceptP),
("/accept" <|> "/ac") *> (AcceptContact <$> incognitoP <* A.space <* char_ '@' <*> displayName), ("/accept " <|> "/ac ") *> char_ '@' *> (AcceptContact <$> displayName),
("/reject " <|> "/rc ") *> char_ '@' *> (RejectContact <$> displayName), ("/reject " <|> "/rc ") *> char_ '@' *> (RejectContact <$> displayName),
("/markdown" <|> "/m") $> ChatHelp HSMarkdown, ("/markdown" <|> "/m") $> ChatHelp HSMarkdown,
("/welcome" <|> "/w") $> Welcome, ("/welcome" <|> "/w") $> Welcome,
@ -5212,7 +5207,7 @@ chatCommandP =
"/set disappear #" *> (SetGroupTimedMessages <$> displayName <*> (A.space *> timedTTLOnOffP)), "/set disappear #" *> (SetGroupTimedMessages <$> displayName <*> (A.space *> timedTTLOnOffP)),
"/set disappear @" *> (SetContactTimedMessages <$> displayName <*> optional (A.space *> timedMessagesEnabledP)), "/set disappear @" *> (SetContactTimedMessages <$> displayName <*> optional (A.space *> timedMessagesEnabledP)),
"/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))), "/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))),
("/incognito" <* optional (A.space *> onOffP)) $> ChatHelp HSIncognito, "/incognito " *> (SetIncognito <$> onOffP),
("/quit" <|> "/q" <|> "/exit") $> QuitChat, ("/quit" <|> "/q" <|> "/exit") $> QuitChat,
("/version" <|> "/v") $> ShowVersion, ("/version" <|> "/v") $> ShowVersion,
"/debug locks" $> DebugLocks, "/debug locks" $> DebugLocks,
@ -5221,8 +5216,6 @@ chatCommandP =
] ]
where where
choice = A.choice . map (\p -> p <* A.takeWhile (== ' ') <* A.endOfInput) 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,") imagePrefix = (<>) <$> "data:" <*> ("image/png;base64," <|> "image/jpg;base64,")
imageP = safeDecodeUtf8 <$> ((<>) <$> imagePrefix <*> (B64.encode <$> base64P)) imageP = safeDecodeUtf8 <$> ((<>) <$> imagePrefix <*> (B64.encode <$> base64P))
chatTypeP = A.char '@' $> CTDirect <|> A.char '#' $> CTGroup <|> A.char ':' $> CTContactConnection chatTypeP = A.char '@' $> CTDirect <|> A.char '#' $> CTGroup <|> A.char ':' $> CTContactConnection

View File

@ -176,6 +176,7 @@ data ChatController = ChatController
currentCalls :: TMap ContactId Call, currentCalls :: TMap ContactId Call,
config :: ChatConfig, 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,
expireCIThreads :: TMap UserId (Maybe (Async ())), expireCIThreads :: TMap UserId (Maybe (Async ())),
expireCIFlags :: TMap UserId Bool, expireCIFlags :: TMap UserId Bool,
cleanupManagerAsync :: TVar (Maybe (Async ())), cleanupManagerAsync :: TVar (Maybe (Async ())),
@ -186,7 +187,7 @@ data ChatController = ChatController
logFilePath :: Maybe FilePath logFilePath :: Maybe FilePath
} }
data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSIncognito | HSMarkdown | HSMessages | HSSettings | HSDatabase data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSMarkdown | HSMessages | HSSettings | HSDatabase
deriving (Show, Generic) deriving (Show, Generic)
instance ToJSON HelpSection where instance ToJSON HelpSection where
@ -222,6 +223,7 @@ data ChatCommand
| SetTempFolder FilePath | SetTempFolder FilePath
| SetFilesFolder FilePath | SetFilesFolder FilePath
| APISetXFTPConfig (Maybe XFTPFileConfig) | APISetXFTPConfig (Maybe XFTPFileConfig)
| SetIncognito Bool
| APIExportArchive ArchiveConfig | APIExportArchive ArchiveConfig
| ExportArchive | ExportArchive
| APIImportArchive ArchiveConfig | APIImportArchive ArchiveConfig
@ -242,7 +244,7 @@ data ChatCommand
| APIChatUnread ChatRef Bool | APIChatUnread ChatRef Bool
| APIDeleteChat ChatRef | APIDeleteChat ChatRef
| APIClearChat ChatRef | APIClearChat ChatRef
| APIAcceptContact IncognitoEnabled Int64 | APIAcceptContact Int64
| APIRejectContact Int64 | APIRejectContact Int64
| APISendCallInvitation ContactId CallType | APISendCallInvitation ContactId CallType
| SendCallInvitation ContactName CallType | SendCallInvitation ContactName CallType
@ -320,12 +322,11 @@ data ChatCommand
| EnableGroupMember GroupName ContactName | EnableGroupMember GroupName ContactName
| ChatHelp HelpSection | ChatHelp HelpSection
| Welcome | Welcome
| APIAddContact UserId IncognitoEnabled | APIAddContact UserId
| AddContact IncognitoEnabled | AddContact
| APISetConnectionIncognito Int64 IncognitoEnabled | APIConnect UserId (Maybe AConnectionRequestUri)
| APIConnect UserId IncognitoEnabled (Maybe AConnectionRequestUri) | Connect (Maybe AConnectionRequestUri)
| Connect IncognitoEnabled (Maybe AConnectionRequestUri) | ConnectSimplex -- UserId (not used in UI)
| ConnectSimplex IncognitoEnabled -- UserId (not used in UI)
| DeleteContact ContactName | DeleteContact ContactName
| ClearContact ContactName | ClearContact ContactName
| APIListContacts UserId | APIListContacts UserId
@ -340,7 +341,7 @@ data ChatCommand
| SetProfileAddress Bool | SetProfileAddress Bool
| APIAddressAutoAccept UserId (Maybe AutoAccept) | APIAddressAutoAccept UserId (Maybe AutoAccept)
| AddressAutoAccept (Maybe AutoAccept) | AddressAutoAccept (Maybe AutoAccept)
| AcceptContact IncognitoEnabled ContactName | AcceptContact ContactName
| RejectContact ContactName | RejectContact ContactName
| SendMessage ChatName Text | SendMessage ChatName Text
| SendLiveMessage ChatName Text | SendLiveMessage ChatName Text
@ -466,8 +467,7 @@ data ChatResponse
| CRUserProfileNoChange {user :: User} | CRUserProfileNoChange {user :: User}
| CRUserPrivacy {user :: User, updatedUser :: User} | CRUserPrivacy {user :: User, updatedUser :: User}
| CRVersionInfo {versionInfo :: CoreVersionInfo, chatMigrations :: [UpMigration], agentMigrations :: [UpMigration]} | CRVersionInfo {versionInfo :: CoreVersionInfo, chatMigrations :: [UpMigration], agentMigrations :: [UpMigration]}
| CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation, connection :: PendingContactConnection} | CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation}
| CRConnectionIncognitoUpdated {user :: User, toConnection :: PendingContactConnection}
| CRSentConfirmation {user :: User} | CRSentConfirmation {user :: User}
| CRSentInvitation {user :: User, customUserProfile :: Maybe Profile} | CRSentInvitation {user :: User, customUserProfile :: Maybe Profile}
| CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact} | CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
@ -876,7 +876,6 @@ data ChatErrorType
| CEServerProtocol {serverProtocol :: AProtocolType} | CEServerProtocol {serverProtocol :: AProtocolType}
| CEAgentCommandError {message :: String} | CEAgentCommandError {message :: String}
| CEInvalidFileDescription {message :: String} | CEInvalidFileDescription {message :: String}
| CEConnectionIncognitoChangeProhibited
| CEInternalError {message :: String} | CEInternalError {message :: String}
| CEException {message :: String} | CEException {message :: String}
deriving (Show, Exception, Generic) deriving (Show, Exception, Generic)

View File

@ -8,7 +8,6 @@ module Simplex.Chat.Help
groupsHelpInfo, groupsHelpInfo,
contactsHelpInfo, contactsHelpInfo,
myAddressHelpInfo, myAddressHelpInfo,
incognitoHelpInfo,
messagesHelpInfo, messagesHelpInfo,
markdownInfo, markdownInfo,
settingsInfo, settingsInfo,
@ -49,7 +48,7 @@ chatWelcome user =
"Welcome " <> green userName <> "!", "Welcome " <> green userName <> "!",
"Thank you for installing SimpleX Chat!", "Thank you for installing SimpleX Chat!",
"", "",
"Connect to SimpleX Chat developers for any questions - just type " <> highlight "/simplex", "Connect to SimpleX Chat lead developer for any questions - just type " <> highlight "/simplex",
"", "",
"Follow our updates:", "Follow our updates:",
"> Reddit: https://www.reddit.com/r/SimpleXChat/", "> Reddit: https://www.reddit.com/r/SimpleXChat/",
@ -214,26 +213,6 @@ myAddressHelpInfo =
"The commands may be abbreviated: " <> listHighlight ["/ad", "/da", "/sa", "/ac", "/rc"] "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 :: [StyledString]
messagesHelpInfo = messagesHelpInfo =
map map
@ -290,6 +269,7 @@ settingsInfo =
map map
styleMarkdown styleMarkdown
[ green "Chat settings:", [ green "Chat settings:",
indent <> highlight "/incognito on/off " <> " - enable/disable incognito mode",
indent <> highlight "/network " <> " - show / set network access options", indent <> highlight "/network " <> " - show / set network access options",
indent <> highlight "/smp " <> " - show / set configured SMP servers", indent <> highlight "/smp " <> " - show / set configured SMP servers",
indent <> highlight "/xftp " <> " - show / set configured XFTP servers", indent <> highlight "/xftp " <> " - show / set configured XFTP servers",
@ -305,12 +285,12 @@ databaseHelpInfo :: [StyledString]
databaseHelpInfo = databaseHelpInfo =
map map
styleMarkdown styleMarkdown
[ green "Database export:", [ green "Database export:",
indent <> highlight "/db export " <> " - create database export file that can be imported in mobile apps", 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", indent <> highlight "/files_folder <path> " <> " - set files folder path to include app files in the exported archive",
"", "",
green "Database encryption:", green "Database encryption:",
indent <> highlight "/db encrypt <key> " <> " - encrypt chat database with key/passphrase", 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 key <current> <new>" <> " - change the key of the encrypted app database",
indent <> highlight "/db decrypt <key> " <> " - decrypt chat database" indent <> highlight "/db decrypt <key> " <> " - decrypt chat database"
] ]

View File

@ -17,7 +17,6 @@ module Simplex.Chat.Store.Direct
getPendingContactConnection, getPendingContactConnection,
deletePendingContactConnection, deletePendingContactConnection,
createDirectConnection, createDirectConnection,
createIncognitoProfile,
createConnReqConnection, createConnReqConnection,
getProfileById, getProfileById,
getConnReqContactXContactId, getConnReqContactXContactId,
@ -34,8 +33,6 @@ module Simplex.Chat.Store.Direct
updateContactUserPreferences, updateContactUserPreferences,
updateContactAlias, updateContactAlias,
updateContactConnectionAlias, updateContactConnectionAlias,
updatePCCIncognito,
deletePCCIncognitoProfile,
updateContactUsed, updateContactUsed,
updateContactUnreadChat, updateContactUnreadChat,
updateGroupUnreadChat, updateGroupUnreadChat,
@ -174,11 +171,6 @@ createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile
pccConnId <- insertedRowId db pccConnId <- insertedRowId db
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connReqInv = Just cReq, localAlias = "", createdAt, updatedAt = createdAt} 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.Connection -> UserId -> UTCTime -> Profile -> IO Int64
createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, image} = do createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, image} = do
DB.execute DB.execute
@ -315,30 +307,7 @@ updateContactConnectionAlias db userId conn localAlias = do
WHERE user_id = ? AND connection_id = ? WHERE user_id = ? AND connection_id = ?
|] |]
(localAlias, updatedAt, userId, pccConnId conn) (localAlias, updatedAt, userId, pccConnId conn)
pure (conn :: PendingContactConnection) {localAlias, updatedAt} pure (conn :: PendingContactConnection) {localAlias}
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.Connection -> User -> Contact -> IO ()
updateContactUsed db User {userId} Contact {contactId} = do updateContactUsed db User {userId} Contact {contactId} = do

View File

@ -397,14 +397,14 @@ data UserContactLink = UserContactLink
instance ToJSON UserContactLink where toEncoding = J.genericToEncoding J.defaultOptions instance ToJSON UserContactLink where toEncoding = J.genericToEncoding J.defaultOptions
data AutoAccept = AutoAccept data AutoAccept = AutoAccept
{ acceptIncognito :: IncognitoEnabled, { acceptIncognito :: Bool,
autoReply :: Maybe MsgContent autoReply :: Maybe MsgContent
} }
deriving (Show, Generic) deriving (Show, Generic)
instance ToJSON AutoAccept where toEncoding = J.genericToEncoding J.defaultOptions instance ToJSON AutoAccept where toEncoding = J.genericToEncoding J.defaultOptions
toUserContactLink :: (ConnReqContact, Bool, IncognitoEnabled, Maybe MsgContent) -> UserContactLink toUserContactLink :: (ConnReqContact, Bool, Bool, Maybe MsgContent) -> UserContactLink
toUserContactLink (connReq, autoAccept, acceptIncognito, autoReply) = toUserContactLink (connReq, autoAccept, acceptIncognito, autoReply) =
UserContactLink connReq $ UserContactLink connReq $
if autoAccept then Just AutoAccept {acceptIncognito, autoReply} else Nothing if autoAccept then Just AutoAccept {acceptIncognito, autoReply} else Nothing
@ -452,6 +452,9 @@ updateUserAddressAutoAccept db user@User {userId} autoAccept = do
Just AutoAccept {acceptIncognito, autoReply} -> (True, acceptIncognito, autoReply) Just AutoAccept {acceptIncognito, autoReply} -> (True, acceptIncognito, autoReply)
_ -> (False, False, Nothing) _ -> (False, False, Nothing)
getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> IO [ServerCfg p] getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> IO [ServerCfg p]
getProtocolServers db User {userId} = getProtocolServers db User {userId} =
map toServerCfg map toServerCfg

View File

@ -203,7 +203,7 @@ createContact_ db userId connId Profile {displayName, fullName, image, contactLi
pure $ Right (ldn, contactId, profileId) pure $ Right (ldn, contactId, profileId)
deleteUnusedIncognitoProfileById_ :: DB.Connection -> User -> ProfileId -> IO () deleteUnusedIncognitoProfileById_ :: DB.Connection -> User -> ProfileId -> IO ()
deleteUnusedIncognitoProfileById_ db User {userId} profileId = deleteUnusedIncognitoProfileById_ db User {userId} profile_id =
DB.executeNamed DB.executeNamed
db db
[sql| [sql|
@ -218,7 +218,7 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId =
WHERE user_id = :user_id AND member_profile_id = :profile_id LIMIT 1 WHERE user_id = :user_id AND member_profile_id = :profile_id LIMIT 1
) )
|] |]
[":user_id" := userId, ":profile_id" := profileId] [":user_id" := userId, ":profile_id" := profile_id]
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) 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)

View File

@ -184,9 +184,7 @@ contactConn = activeConn
contactConnId :: Contact -> ConnId contactConnId :: Contact -> ConnId
contactConnId = aConnId . contactConn contactConnId = aConnId . contactConn
type IncognitoEnabled = Bool contactConnIncognito :: Contact -> Bool
contactConnIncognito :: Contact -> IncognitoEnabled
contactConnIncognito = connIncognito . contactConn contactConnIncognito = connIncognito . contactConn
contactDirect :: Contact -> Bool contactDirect :: Contact -> Bool
@ -597,7 +595,7 @@ memberConnId GroupMember {activeConn} = aConnId <$> activeConn
groupMemberId' :: GroupMember -> GroupMemberId groupMemberId' :: GroupMember -> GroupMemberId
groupMemberId' GroupMember {groupMemberId} = groupMemberId groupMemberId' GroupMember {groupMemberId} = groupMemberId
memberIncognito :: GroupMember -> IncognitoEnabled memberIncognito :: GroupMember -> Bool
memberIncognito GroupMember {memberProfile, memberContactProfileId} = localProfileId memberProfile /= memberContactProfileId memberIncognito GroupMember {memberProfile, memberContactProfileId} = localProfileId memberProfile /= memberContactProfileId
memberSecurityCode :: GroupMember -> Maybe SecurityCode memberSecurityCode :: GroupMember -> Maybe SecurityCode

View File

@ -115,7 +115,6 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
HSGroups -> groupsHelpInfo HSGroups -> groupsHelpInfo
HSContacts -> contactsHelpInfo HSContacts -> contactsHelpInfo
HSMyAddress -> myAddressHelpInfo HSMyAddress -> myAddressHelpInfo
HSIncognito -> incognitoHelpInfo
HSMessages -> messagesHelpInfo HSMessages -> messagesHelpInfo
HSMarkdown -> markdownInfo HSMarkdown -> markdownInfo
HSSettings -> settingsInfo HSSettings -> settingsInfo
@ -139,8 +138,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
CRUserProfileNoChange u -> ttyUser u ["user profile did not change"] CRUserProfileNoChange u -> ttyUser u ["user profile did not change"]
CRUserPrivacy u u' -> ttyUserPrefix u $ viewUserPrivacy u u' CRUserPrivacy u u' -> ttyUserPrefix u $ viewUserPrivacy u u'
CRVersionInfo info _ _ -> viewVersionInfo logLevel info 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!"] CRSentConfirmation u -> ttyUser u ["confirmation sent!"]
CRSentInvitation u customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView CRSentInvitation u customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"] CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"]
@ -1150,11 +1148,6 @@ viewConnectionAliasUpdated PendingContactConnection {pccConnId, localAlias}
| localAlias == "" = ["connection " <> sShow pccConnId <> " alias removed"] | localAlias == "" = ["connection " <> sShow pccConnId <> " alias removed"]
| otherwise = ["connection " <> sShow pccConnId <> " alias updated: " <> plain localAlias] | 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 -> Contact -> [StyledString]
viewContactUpdated viewContactUpdated
Contact {localDisplayName = n, profile = LocalProfile {fullName, contactLink}} Contact {localDisplayName = n, profile = LocalProfile {fullName, contactLink}}
@ -1546,7 +1539,6 @@ viewChatError logLevel = \case
CECommandError e -> ["bad chat command: " <> plain e] CECommandError e -> ["bad chat command: " <> plain e]
CEAgentCommandError e -> ["agent command error: " <> plain e] CEAgentCommandError e -> ["agent command error: " <> plain e]
CEInvalidFileDescription e -> ["invalid file description: " <> plain e] CEInvalidFileDescription e -> ["invalid file description: " <> plain e]
CEConnectionIncognitoChangeProhibited -> ["incognito mode change prohibited"]
CEInternalError e -> ["internal chat error: " <> plain e] CEInternalError e -> ["internal chat error: " <> plain e]
CEException e -> ["exception: " <> plain e] CEException e -> ["exception: " <> plain e]
-- e -> ["chat error: " <> sShow e] -- e -> ["chat error: " <> sShow e]

View File

@ -1817,7 +1817,8 @@ testGroupLinkIncognitoMembership =
-- bob connected incognito to alice -- bob connected incognito to alice
alice ##> "/c" alice ##> "/c"
inv <- getInvitation alice inv <- getInvitation alice
bob ##> ("/c i " <> inv) bob #$> ("/incognito on", id, "ok")
bob ##> ("/c " <> inv)
bob <## "confirmation sent!" bob <## "confirmation sent!"
bobIncognito <- getTermLine bob bobIncognito <- getTermLine bob
concurrentlyN_ concurrentlyN_
@ -1826,6 +1827,7 @@ testGroupLinkIncognitoMembership =
bob <## "use /i alice to print out this incognito profile again", bob <## "use /i alice to print out this incognito profile again",
alice <## (bobIncognito <> ": contact is connected") alice <## (bobIncognito <> ": contact is connected")
] ]
bob #$> ("/incognito off", id, "ok")
-- alice creates group -- alice creates group
alice ##> "/g team" alice ##> "/g team"
alice <## "group #team is created" alice <## "group #team is created"
@ -1868,7 +1870,8 @@ testGroupLinkIncognitoMembership =
cath #> ("@" <> bobIncognito <> " hey, I'm cath") cath #> ("@" <> bobIncognito <> " hey, I'm cath")
bob ?<# "cath> hey, I'm cath" bob ?<# "cath> hey, I'm cath"
-- dan joins incognito -- dan joins incognito
dan ##> ("/c i " <> gLink) dan #$> ("/incognito on", id, "ok")
dan ##> ("/c " <> gLink)
danIncognito <- getTermLine dan danIncognito <- getTermLine dan
dan <## "connection request sent incognito!" dan <## "connection request sent incognito!"
bob <## (danIncognito <> ": accepting request to join group #team...") bob <## (danIncognito <> ": accepting request to join group #team...")
@ -1895,6 +1898,7 @@ testGroupLinkIncognitoMembership =
cath <## ("#team: " <> bobIncognito <> " added " <> danIncognito <> " to the group (connecting...)") cath <## ("#team: " <> bobIncognito <> " added " <> danIncognito <> " to the group (connecting...)")
cath <## ("#team: new member " <> danIncognito <> " is connected") cath <## ("#team: new member " <> danIncognito <> " is connected")
] ]
dan #$> ("/incognito off", id, "ok")
bob ?#> ("@" <> danIncognito <> " hi, I'm incognito") bob ?#> ("@" <> danIncognito <> " hi, I'm incognito")
dan ?<# (bobIncognito <> "> hi, I'm incognito") dan ?<# (bobIncognito <> "> hi, I'm incognito")
dan ?#> ("@" <> bobIncognito <> " hey, me too") dan ?#> ("@" <> bobIncognito <> " hey, me too")
@ -2002,6 +2006,7 @@ testGroupLinkIncognitoUnusedHostContactsDeleted :: HasCallStack => FilePath -> I
testGroupLinkIncognitoUnusedHostContactsDeleted = testGroupLinkIncognitoUnusedHostContactsDeleted =
testChatCfg2 cfg aliceProfile bobProfile $ testChatCfg2 cfg aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
bob #$> ("/incognito on", id, "ok")
bobIncognitoTeam <- createGroupBobIncognito alice bob "team" "alice" bobIncognitoTeam <- createGroupBobIncognito alice bob "team" "alice"
bobIncognitoClub <- createGroupBobIncognito alice bob "club" "alice_1" bobIncognitoClub <- createGroupBobIncognito alice bob "club" "alice_1"
bobIncognitoTeam `shouldNotBe` bobIncognitoClub bobIncognitoTeam `shouldNotBe` bobIncognitoClub
@ -2031,7 +2036,7 @@ testGroupLinkIncognitoUnusedHostContactsDeleted =
alice <## ("to add members use /a " <> group <> " <name> or /create link #" <> group) alice <## ("to add members use /a " <> group <> " <name> or /create link #" <> group)
alice ##> ("/create link #" <> group) alice ##> ("/create link #" <> group)
gLinkTeam <- getGroupLink alice group GRMember True gLinkTeam <- getGroupLink alice group GRMember True
bob ##> ("/c i " <> gLinkTeam) bob ##> ("/c " <> gLinkTeam)
bobIncognito <- getTermLine bob bobIncognito <- getTermLine bob
bob <## "connection request sent incognito!" bob <## "connection request sent incognito!"
alice <## (bobIncognito <> ": accepting request to join group #" <> group <> "...") alice <## (bobIncognito <> ": accepting request to join group #" <> group <> "...")

View File

@ -27,15 +27,10 @@ chatProfileTests = do
it "delete connection requests when contact link deleted" testDeleteConnectionRequests it "delete connection requests when contact link deleted" testDeleteConnectionRequests
it "auto-reply message" testAutoReplyMessage it "auto-reply message" testAutoReplyMessage
it "auto-reply message in incognito" testAutoReplyMessageInIncognito it "auto-reply message in incognito" testAutoReplyMessageInIncognito
describe "incognito" $ do describe "incognito mode" $ do
it "connect incognito via invitation link" testConnectIncognitoInvitationLink it "connect incognito via invitation link" testConnectIncognitoInvitationLink
it "connect incognito via contact address" testConnectIncognitoContactAddress it "connect incognito via contact address" testConnectIncognitoContactAddress
it "accept contact request incognito" testAcceptContactRequestIncognito 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 "join group incognito" testJoinGroupIncognito
it "can't invite contact to whom user connected incognito to a group" testCantInviteContactIncognito it "can't invite contact to whom user connected incognito to a group" testCantInviteContactIncognito
it "can't see global preferences update" testCantSeeGlobalPrefsUpdateIncognito it "can't see global preferences update" testCantSeeGlobalPrefsUpdateIncognito
@ -494,9 +489,11 @@ testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $
testConnectIncognitoInvitationLink :: HasCallStack => FilePath -> IO () testConnectIncognitoInvitationLink :: HasCallStack => FilePath -> IO ()
testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $ testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
alice ##> "/connect incognito" alice #$> ("/incognito on", id, "ok")
bob #$> ("/incognito on", id, "ok")
alice ##> "/c"
inv <- getInvitation alice inv <- getInvitation alice
bob ##> ("/connect incognito " <> inv) bob ##> ("/c " <> inv)
bob <## "confirmation sent!" bob <## "confirmation sent!"
bobIncognito <- getTermLine bob bobIncognito <- getTermLine bob
aliceIncognito <- getTermLine alice aliceIncognito <- getTermLine alice
@ -508,6 +505,9 @@ testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfi
alice <## (bobIncognito <> ": contact is connected, your incognito profile for this contact is " <> aliceIncognito) alice <## (bobIncognito <> ": contact is connected, your incognito profile for this contact is " <> aliceIncognito)
alice <## ("use /i " <> bobIncognito <> " to print out this incognito profile again") 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") alice ?#> ("@" <> bobIncognito <> " psst, I'm incognito")
bob ?<# (aliceIncognito <> "> psst, I'm incognito") bob ?<# (aliceIncognito <> "> psst, I'm incognito")
bob ?#> ("@" <> aliceIncognito <> " <whispering> me too") bob ?#> ("@" <> aliceIncognito <> " <whispering> me too")
@ -569,7 +569,8 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
alice ##> "/ad" alice ##> "/ad"
cLink <- getContactLink alice True cLink <- getContactLink alice True
bob ##> ("/c i " <> cLink) bob #$> ("/incognito on", id, "ok")
bob ##> ("/c " <> cLink)
bobIncognito <- getTermLine bob bobIncognito <- getTermLine bob
bob <## "connection request sent incognito!" bob <## "connection request sent incognito!"
alice <## (bobIncognito <> " wants to connect to you!") alice <## (bobIncognito <> " wants to connect to you!")
@ -584,7 +585,9 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
bob <## "use /i alice to print out this incognito profile again", bob <## "use /i alice to print out this incognito profile again",
alice <## (bobIncognito <> ": contact is connected") alice <## (bobIncognito <> ": contact is connected")
] ]
-- conversation is incognito -- after turning incognito mode off conversation is incognito
alice #$> ("/incognito off", id, "ok")
bob #$> ("/incognito off", id, "ok")
alice #> ("@" <> bobIncognito <> " who are you?") alice #> ("@" <> bobIncognito <> " who are you?")
bob ?<# "alice> who are you?" bob ?<# "alice> who are you?"
bob ?#> "@alice I'm Batman" bob ?#> "@alice I'm Batman"
@ -602,162 +605,39 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
bob `hasContactProfiles` ["bob"] bob `hasContactProfiles` ["bob"]
testAcceptContactRequestIncognito :: HasCallStack => FilePath -> IO () testAcceptContactRequestIncognito :: HasCallStack => FilePath -> IO ()
testAcceptContactRequestIncognito = testChat3 aliceProfile bobProfile cathProfile $ testAcceptContactRequestIncognito = testChat2 aliceProfile bobProfile $
\alice bob cath -> do \alice bob -> do
alice ##> "/ad" alice ##> "/ad"
cLink <- getContactLink alice True cLink <- getContactLink alice True
bob ##> ("/c " <> cLink) bob ##> ("/c " <> cLink)
alice <#? bob alice <#? bob
alice ##> "/accept incognito bob" alice #$> ("/incognito on", id, "ok")
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request..." alice <## "bob (Bob): accepting contact request..."
aliceIncognitoBob <- getTermLine alice aliceIncognito <- getTermLine alice
concurrentlyN_ concurrentlyN_
[ bob <## (aliceIncognitoBob <> ": contact is connected"), [ bob <## (aliceIncognito <> ": contact is connected"),
do do
alice <## ("bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognitoBob) 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 <## "use /i bob to print out this incognito profile again"
] ]
-- conversation is incognito -- after turning incognito mode off conversation is incognito
alice #$> ("/incognito off", id, "ok")
bob #$> ("/incognito off", id, "ok")
alice ?#> "@bob my profile is totally inconspicuous" alice ?#> "@bob my profile is totally inconspicuous"
bob <# (aliceIncognitoBob <> "> my profile is totally inconspicuous") bob <# (aliceIncognito <> "> my profile is totally inconspicuous")
bob #> ("@" <> aliceIncognitoBob <> " I know!") bob #> ("@" <> aliceIncognito <> " I know!")
alice ?<# "bob> I know!" alice ?<# "bob> I know!"
-- list contacts -- list contacts
alice ##> "/contacts" alice ##> "/contacts"
alice <## "i bob (Bob)" alice <## "i bob (Bob)"
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognitoBob] alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito]
-- delete contact, incognito profile is deleted -- delete contact, incognito profile is deleted
alice ##> "/d bob" alice ##> "/d bob"
alice <## "bob: contact is deleted" alice <## "bob: contact is deleted"
alice ##> "/contacts" alice ##> "/contacts"
(alice </) (alice </)
alice `hasContactProfiles` ["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 :: HasCallStack => FilePath -> IO ()
testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfile $ testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfile $
@ -771,7 +651,8 @@ testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfil
-- cath connected incognito to alice -- cath connected incognito to alice
alice ##> "/c" alice ##> "/c"
inv <- getInvitation alice inv <- getInvitation alice
cath ##> ("/c i " <> inv) cath #$> ("/incognito on", id, "ok")
cath ##> ("/c " <> inv)
cath <## "confirmation sent!" cath <## "confirmation sent!"
cathIncognito <- getTermLine cath cathIncognito <- getTermLine cath
concurrentlyN_ concurrentlyN_
@ -804,8 +685,10 @@ testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfil
cath <## "#secret_club: alice invites you to join the group as admin" cath <## "#secret_club: alice invites you to join the group as admin"
cath <## ("use /j secret_club to join incognito as " <> cathIncognito) cath <## ("use /j secret_club to join incognito as " <> cathIncognito)
] ]
-- cath uses the same incognito profile when joining group, cath and bob don't merge contacts -- cath uses the same incognito profile when joining group, disabling incognito mode doesn't affect it
cath #$> ("/incognito off", id, "ok")
cath ##> "/j secret_club" cath ##> "/j secret_club"
-- cath and bob don't merge contacts
concurrentlyN_ concurrentlyN_
[ alice <## ("#secret_club: " <> cathIncognito <> " joined the group"), [ alice <## ("#secret_club: " <> cathIncognito <> " joined the group"),
do do
@ -951,7 +834,8 @@ testCantInviteContactIncognito :: HasCallStack => FilePath -> IO ()
testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $ testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
-- alice connected incognito to bob -- alice connected incognito to bob
alice ##> "/c i" alice #$> ("/incognito on", id, "ok")
alice ##> "/c"
inv <- getInvitation alice inv <- getInvitation alice
bob ##> ("/c " <> inv) bob ##> ("/c " <> inv)
bob <## "confirmation sent!" bob <## "confirmation sent!"
@ -963,6 +847,7 @@ testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
alice <## "use /i bob to print out this incognito profile again" alice <## "use /i bob to print out this incognito profile again"
] ]
-- alice creates group non incognito -- alice creates group non incognito
alice #$> ("/incognito off", id, "ok")
alice ##> "/g club" alice ##> "/g club"
alice <## "group #club is created" alice <## "group #club is created"
alice <## "to add members use /a club <name> or /create link #club" alice <## "to add members use /a club <name> or /create link #club"
@ -974,8 +859,10 @@ testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
testCantSeeGlobalPrefsUpdateIncognito :: HasCallStack => FilePath -> IO () testCantSeeGlobalPrefsUpdateIncognito :: HasCallStack => FilePath -> IO ()
testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathProfile $ testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
alice ##> "/c i" alice #$> ("/incognito on", id, "ok")
alice ##> "/c"
invIncognito <- getInvitation alice invIncognito <- getInvitation alice
alice #$> ("/incognito off", id, "ok")
alice ##> "/c" alice ##> "/c"
inv <- getInvitation alice inv <- getInvitation alice
bob ##> ("/c " <> invIncognito) bob ##> ("/c " <> invIncognito)
@ -1028,7 +915,8 @@ testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobPr
-- bob connects incognito to alice -- bob connects incognito to alice
alice ##> "/c" alice ##> "/c"
inv <- getInvitation alice inv <- getInvitation alice
bob ##> ("/c i " <> inv) bob #$> ("/incognito on", id, "ok")
bob ##> ("/c " <> inv)
bob <## "confirmation sent!" bob <## "confirmation sent!"
bobIncognito <- getTermLine bob bobIncognito <- getTermLine bob
concurrentlyN_ concurrentlyN_
@ -1079,7 +967,8 @@ testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobPr
-- bob connects incognito to alice -- bob connects incognito to alice
alice ##> "/c" alice ##> "/c"
inv <- getInvitation alice inv <- getInvitation alice
bob ##> ("/c i " <> inv) bob #$> ("/incognito on", id, "ok")
bob ##> ("/c " <> inv)
bob <## "confirmation sent!" bob <## "confirmation sent!"
bobIncognito <- getTermLine bob bobIncognito <- getTermLine bob
concurrentlyN_ concurrentlyN_