Revert "core: rework incognito mode - set per connection (#2838)"
This reverts commit 4e27a4ea4f
.
This commit is contained in:
parent
6d113ae2e2
commit
b003d659e4
@ -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
|
||||||
|
@ -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)
|
||||||
|
@ -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"
|
||||||
]
|
]
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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)
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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]
|
||||||
|
@ -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 <> "...")
|
||||||
|
@ -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_
|
||||||
|
Loading…
Reference in New Issue
Block a user