android-apps-mirrors/SimpleX-Chat
0
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-06-28 20:29:53 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

core: connection plan api; check connection plan before connecting in terminal api (#3176)

Browse source
This commit is contained in:
spaced4ndy 2023-10-10 21:19:04 +04:00 • committed by GitHub
parent eb5081624a
commit a67b79952b
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
15 changed files with 784 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

1
simplex-chat.cabal
View file

@ -115,6 +115,7 @@ library
Simplex.Chat.Migrations.M20230914_member_probes
Simplex.Chat.Migrations.M20230926_contact_status
Simplex.Chat.Migrations.M20231002_conn_initiated
Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash
Simplex.Chat.Mobile
Simplex.Chat.Mobile.File
Simplex.Chat.Mobile.Shared

112
src/Simplex/Chat.hs
View file

@ -902,7 +902,7 @@ processChatCommand = \case
filesInfo <- withStore' $ \db -> getContactFileInfo db user ct
withChatLock "deleteChat direct" . procCmd $ do
deleteFilesAndConns user filesInfo
when (isReady ct && contactActive ct && notify) $
when (contactReady ct && contactActive ct && notify) $
void (sendDirectContactMessage ct XDirectDel) `catchChatError` const (pure ())
contactConnIds <- map aConnId <$> withStore (\db -> getContactConnections db userId ct)
deleteAgentConnectionsAsync user contactConnIds
@ -1311,6 +1311,8 @@ processChatCommand = \case
case conn'_ of
Just conn' -> pure $ CRConnectionIncognitoUpdated user conn'
Nothing -> throwChatError CEConnectionIncognitoChangeProhibited
APIConnectPlan userId cReqUri -> withUserId userId $ \user -> withChatLock "connectPlan" . procCmd $
CRConnectionPlan user <$> connectPlan user cReqUri
APIConnect userId incognito (Just (ACR SCMInvitation cReq)) -> withUserId userId $ \user -> withChatLock "connect" . procCmd $ do
subMode <- chatReadVar subscriptionMode
-- [incognito] generate profile to send
@ -1323,11 +1325,16 @@ processChatCommand = \case
pure $ CRSentConfirmation user
APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq
APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq
Connect incognito cReqUri -> withUser $ \User {userId} ->
processChatCommand $ APIConnect userId incognito cReqUri
ConnectSimplex incognito -> withUser $ \user ->
-- [incognito] generate profile to send
connectViaContact user incognito adminContactReq
Connect incognito aCReqUri@(Just cReqUri) -> withUser $ \user@User {userId} -> do
plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk)
unless (connectionPlanOk plan) $ throwChatError (CEConnectionPlan plan)
processChatCommand $ APIConnect userId incognito aCReqUri
Connect _ Nothing -> throwChatError CEInvalidConnReq
ConnectSimplex incognito -> withUser $ \user@User {userId} -> do
let cReqUri = ACR SCMContact adminContactReq
plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk)
unless (connectionPlanOk plan) $ throwChatError (CEConnectionPlan plan)
processChatCommand $ APIConnect userId incognito (Just cReqUri)
DeleteContact cName -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) True
ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect
APIListContacts userId -> withUserId userId $ \user ->
@ -1423,7 +1430,7 @@ processChatCommand = \case
processChatCommand . APISendMessage chatRef True Nothing $ ComposedMessage Nothing Nothing mc
SendMessageBroadcast msg -> withUser $ \user -> do
contacts <- withStore' (`getUserContacts` user)
let cts = filter (\ct -> isReady ct && contactActive ct && directOrUsed ct) contacts
let cts = filter (\ct -> contactReady ct && contactActive ct && directOrUsed ct) contacts
ChatConfig {logLevel} <- asks config
withChatLock "sendMessageBroadcast" . procCmd $ do
(successes, failures) <- foldM (sendAndCount user logLevel) (0, 0) cts
@ -1924,19 +1931,36 @@ processChatCommand = \case
_ -> throwChatError $ CECommandError "not supported"
connectViaContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> m ChatResponse
connectViaContact user@User {userId} incognito cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case
(Just contact, _) -> pure $ CRContactAlreadyExists user contact
(_, xContactId_) -> procCmd $ do
let randomXContactId = XContactId <$> drgRandomBytes 16
xContactId <- maybe randomXContactId pure xContactId_
subMode <- chatReadVar subscriptionMode
let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
case groupLinkId of
-- contact address
Nothing ->
withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case
(Just contact, _) -> pure $ CRContactAlreadyExists user contact
(_, xContactId_) -> procCmd $ do
let randomXContactId = XContactId <$> drgRandomBytes 16
xContactId <- maybe randomXContactId pure xContactId_
connect' Nothing cReqHash xContactId
-- group link
Just gLinkId ->
withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case
(Just _contact, _) -> procCmd $ do
-- allow repeat contact request
newXContactId <- XContactId <$> drgRandomBytes 16
connect' (Just gLinkId) cReqHash newXContactId
(_, xContactId_) -> procCmd $ do
let randomXContactId = XContactId <$> drgRandomBytes 16
xContactId <- maybe randomXContactId pure xContactId_
connect' (Just gLinkId) cReqHash xContactId
where
connect' groupLinkId cReqHash xContactId = do
-- [incognito] generate profile to send
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = userProfileToSend user incognitoProfile Nothing
dm <- directMessage (XContact profileToSend $ Just xContactId)
subMode <- chatReadVar subscriptionMode
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm subMode
let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode
toView $ CRNewContactConnection user conn
pure $ CRSentInvitation user incognitoProfile
@ -1975,7 +1999,7 @@ processChatCommand = \case
-- read contacts before user update to correctly merge preferences
-- [incognito] filter out contacts with whom user has incognito connections
contacts <-
filter (\ct -> isReady ct && contactActive ct && not (contactConnIncognito ct))
filter (\ct -> contactReady ct && contactActive ct && not (contactConnIncognito ct))
<$> withStore' (`getUserContacts` user)
user' <- updateUser
asks currentUser >>= atomically . (`writeTVar` Just user')
@ -2046,10 +2070,6 @@ processChatCommand = \case
g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db ->
getGroupIdByName db user gName >>= getGroup db user
runUpdateGroupProfile user g $ update p
isReady :: Contact -> Bool
isReady ct =
let s = connStatus $ ct.activeConn
in s == ConnReady || s == ConnSndReady
withCurrentCall :: ContactId -> (User -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse
withCurrentCall ctId action = do
(user, ct) <- withStore $ \db -> do
@ -2168,6 +2188,54 @@ processChatCommand = \case
pure (gId, chatSettings)
_ -> throwChatError $ CECommandError "not supported"
processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ updateSettings chatSettings
connectPlan :: User -> AConnectionRequestUri -> m ConnectionPlan
connectPlan user (ACR SCMInvitation cReq) = do
withStore' (\db -> getConnectionEntityByConnReq db user cReq) >>= \case
Nothing -> pure $ CPInvitationLink ILPOk
Just (RcvDirectMsgConnection conn ct_) -> do
let Connection {connStatus, contactConnInitiated} = conn
if
| connStatus == ConnNew && contactConnInitiated ->
pure $ CPInvitationLink ILPOwnLink
| not (connReady conn) ->
pure $ CPInvitationLink (ILPConnecting ct_)
| otherwise -> case ct_ of
Just ct -> pure $ CPInvitationLink (ILPKnown ct)
Nothing -> throwChatError $ CEInternalError "ready RcvDirectMsgConnection connection should have associated contact"
Just _ -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection"
connectPlan user (ACR SCMContact cReq) = do
let CRContactUri ConnReqUriData {crClientData} = cReq
groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
case groupLinkId of
-- contact address
Nothing ->
withStore' (`getUserContactLinkByConnReq` cReq) >>= \case
Just _ -> pure $ CPContactAddress CAPOwnLink
Nothing -> do
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
withStore' (\db -> getContactByConnReqHash db user cReqHash) >>= \case
Nothing -> pure $ CPContactAddress CAPOk
Just ct
| not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnecting ct)
| otherwise -> pure $ CPContactAddress (CAPKnown ct)
-- group link
Just _ ->
withStore' (\db -> getGroupInfoByUserContactLinkConnReq db user cReq) >>= \case
Just g -> pure $ CPGroupLink (GLPOwnLink g)
Nothing -> do
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
ct_ <- withStore' $ \db -> getContactByConnReqHash db user cReqHash
gInfo_ <- withStore' $ \db -> getGroupInfoByGroupLinkHash db user cReqHash
case (gInfo_, ct_) of
(Nothing, Nothing) -> pure $ CPGroupLink GLPOk
(Nothing, Just ct)
| not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnecting gInfo_)
| otherwise -> pure $ CPGroupLink GLPOk
(Just gInfo@GroupInfo {membership}, _)
| not (memberActive membership) && not (memberRemoved membership) ->
pure $ CPGroupLink (GLPConnecting gInfo_)
| memberActive membership -> pure $ CPGroupLink (GLPKnown gInfo)
| otherwise -> pure $ CPGroupLink GLPOk
assertDirectAllowed :: ChatMonad m => User -> MsgDirection -> Contact -> CMEventTag e -> m ()
assertDirectAllowed user dir ct event =
@ -4230,7 +4298,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> m ()
processGroupInvitation ct inv msg msgMeta = do
let Contact {localDisplayName = c, activeConn = Connection {peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'}} = ct
let Contact {localDisplayName = c, activeConn = Connection {connId, peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'}} = ct
GroupInvitation {fromMember = (MemberIdRole fromMemId fromRole), invitedMember = (MemberIdRole memId memRole), connRequest, groupLinkId} = inv
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c)
@ -4243,6 +4311,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
dm <- directMessage $ XGrpAcpt memberId
connIds <- joinAgentConnectionAsync user True connRequest dm subMode
withStore' $ \db -> do
setViaGroupLinkHash db groupId connId
createMemberConnectionAsync db user hostId connIds (fromJVersionRange peerChatVRange) subMode
updateGroupMemberStatusById db userId hostId GSMemAccepted
updateGroupMemberStatus db userId membership GSMemAccepted
@ -5642,6 +5711,7 @@ chatCommandP =
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP),
"/_contacts " *> (APIListContacts <$> A.decimal),
"/contacts" $> ListContacts,
"/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> strP),
"/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
"/_connect " *> (APIAddContact <$> A.decimal <*> incognitoOnOffP),
"/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP),

61
src/Simplex/Chat/Controller.hs
View file

@ -338,6 +338,7 @@ data ChatCommand
| APIAddContact UserId IncognitoEnabled
| AddContact IncognitoEnabled
| APISetConnectionIncognito Int64 IncognitoEnabled
| APIConnectPlan UserId AConnectionRequestUri
| APIConnect UserId IncognitoEnabled (Maybe AConnectionRequestUri)
| Connect IncognitoEnabled (Maybe AConnectionRequestUri)
| ConnectSimplex IncognitoEnabled -- UserId (not used in UI)
@ -489,6 +490,7 @@ data ChatResponse
| CRVersionInfo {versionInfo :: CoreVersionInfo, chatMigrations :: [UpMigration], agentMigrations :: [UpMigration]}
| CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation, connection :: PendingContactConnection}
| CRConnectionIncognitoUpdated {user :: User, toConnection :: PendingContactConnection}
| CRConnectionPlan {user :: User, connectionPlan :: ConnectionPlan}
| CRSentConfirmation {user :: User}
| CRSentInvitation {user :: User, customUserProfile :: Maybe Profile}
| CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
@ -624,6 +626,64 @@ instance ToJSON ChatResponse where
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
data ConnectionPlan
= CPInvitationLink {invitationLinkPlan :: InvitationLinkPlan}
| CPContactAddress {contactAddressPlan :: ContactAddressPlan}
| CPGroupLink {groupLinkPlan :: GroupLinkPlan}
deriving (Show, Generic)
instance ToJSON ConnectionPlan where
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CP"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CP"
data InvitationLinkPlan
= ILPOk
| ILPOwnLink
| ILPConnecting {contact_ :: Maybe Contact}
| ILPKnown {contact :: Contact}
deriving (Show, Generic)
instance ToJSON InvitationLinkPlan where
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "ILP"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "ILP"
data ContactAddressPlan
= CAPOk
| CAPOwnLink
| CAPConnecting {contact :: Contact}
| CAPKnown {contact :: Contact}
deriving (Show, Generic)
instance ToJSON ContactAddressPlan where
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CAP"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CAP"
data GroupLinkPlan
= GLPOk
| GLPOwnLink {groupInfo :: GroupInfo}
| GLPConnecting {groupInfo_ :: Maybe GroupInfo}
| GLPKnown {groupInfo :: GroupInfo}
deriving (Show, Generic)
instance ToJSON GroupLinkPlan where
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "GLP"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "GLP"
connectionPlanOk :: ConnectionPlan -> Bool
connectionPlanOk = \case
CPInvitationLink ilp -> case ilp of
ILPOk -> True
ILPOwnLink -> True
_ -> False
CPContactAddress cap -> case cap of
CAPOk -> True
CAPOwnLink -> True
_ -> False
CPGroupLink glp -> case glp of
GLPOk -> True
GLPOwnLink _ -> True
_ -> False
newtype UserPwd = UserPwd {unUserPwd :: Text}
deriving (Eq, Show)
@ -888,6 +948,7 @@ data ChatErrorType
| CEChatNotStarted
| CEChatNotStopped
| CEChatStoreChanged
| CEConnectionPlan {connectionPlan :: ConnectionPlan}
| CEInvalidConnReq
| CEInvalidChatMessage {connection :: Connection, msgMeta :: Maybe MsgMetaJSON, messageData :: Text, message :: String}
| CEContactNotFound {contactName :: ContactName, suspectedMember :: Maybe (GroupInfo, GroupMember)}

24
src/Simplex/Chat/Migrations/M20231009_via_group_link_uri_hash.hs Normal file
View file

@ -0,0 +1,24 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20231009_via_group_link_uri_hash :: Query
m20231009_via_group_link_uri_hash =
[sql|
CREATE INDEX idx_connections_conn_req_inv ON connections(conn_req_inv);
ALTER TABLE groups ADD COLUMN via_group_link_uri_hash BLOB;
CREATE INDEX idx_groups_via_group_link_uri_hash ON groups(via_group_link_uri_hash);
|]
down_m20231009_via_group_link_uri_hash :: Query
down_m20231009_via_group_link_uri_hash =
[sql|
DROP INDEX idx_groups_via_group_link_uri_hash;
ALTER TABLE groups DROP COLUMN via_group_link_uri_hash;
DROP INDEX idx_connections_conn_req_inv;
|]

7
src/Simplex/Chat/Migrations/chat_schema.sql
View file

@ -117,7 +117,8 @@ CREATE TABLE groups(
unread_chat INTEGER DEFAULT 0 CHECK(unread_chat NOT NULL),
chat_ts TEXT,
favorite INTEGER NOT NULL DEFAULT 0,
send_rcpts INTEGER, -- received
send_rcpts INTEGER,
via_group_link_uri_hash BLOB, -- received
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
@ -736,3 +737,7 @@ CREATE INDEX idx_received_probes_probe_hash ON received_probes(probe_hash);
CREATE INDEX idx_sent_probes_created_at ON sent_probes(created_at);
CREATE INDEX idx_sent_probe_hashes_created_at ON sent_probe_hashes(created_at);
CREATE INDEX idx_received_probes_created_at ON received_probes(created_at);
CREATE INDEX idx_connections_conn_req_inv ON connections(conn_req_inv);
CREATE INDEX idx_groups_via_group_link_uri_hash ON groups(
via_group_link_uri_hash
);

9
src/Simplex/Chat/Store/Connections.hs
View file

@ -9,6 +9,7 @@
module Simplex.Chat.Store.Connections
( getConnectionEntity,
getConnectionEntityByConnReq,
getConnectionsToSubscribe,
unsetConnectionToSubscribe,
)
@ -31,7 +32,7 @@ import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Messaging.Agent.Protocol (ConnId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow')
import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Util (eitherToMaybe)
@ -152,6 +153,12 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId}
userContact_ _ = Left SEUserContactLinkNotFound
getConnectionEntityByConnReq :: DB.Connection -> User -> ConnReqInvitation -> IO (Maybe ConnectionEntity)
getConnectionEntityByConnReq db user cReq = do
connId_ <- maybeFirstRow fromOnly $
DB.query db "SELECT agent_conn_id FROM connections WHERE conn_req_inv = ? LIMIT 1" (Only cReq)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db user) connId_
getConnectionsToSubscribe :: DB.Connection -> IO ([ConnId], [ConnectionEntity])
getConnectionsToSubscribe db = do
aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1"

48
src/Simplex/Chat/Store/Direct.hs
View file

@ -25,6 +25,7 @@ module Simplex.Chat.Store.Direct
createConnReqConnection,
getProfileById,
getConnReqContactXContactId,
getContactByConnReqHash,
createDirectContact,
deleteContactConnectionsAndFiles,
deleteContact,
@ -137,32 +138,10 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou
getConnReqContactXContactId :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId)
getConnReqContactXContactId db user@User {userId} cReqHash = do
getContact' >>= \case
getContactByConnReqHash db user cReqHash >>= \case
c@(Just _) -> pure (c, Nothing)
Nothing -> (Nothing,) <$> getXContactId
where
getContact' :: IO (Maybe Contact)
getContact' =
maybeFirstRow (toContact user) $
DB.query
db
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
JOIN connections c ON c.contact_id = ct.contact_id
WHERE ct.user_id = ? AND c.via_contact_uri_hash = ? AND ct.deleted = 0
ORDER BY c.created_at DESC
LIMIT 1
|]
(userId, cReqHash)
getXContactId :: IO (Maybe XContactId)
getXContactId =
maybeFirstRow fromOnly $
@ -171,6 +150,29 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do
"SELECT xcontact_id FROM connections WHERE user_id = ? AND via_contact_uri_hash = ? LIMIT 1"
(userId, cReqHash)
getContactByConnReqHash :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe Contact)
getContactByConnReqHash db user@User {userId} cReqHash =
maybeFirstRow (toContact user) $
DB.query
db
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
JOIN connections c ON c.contact_id = ct.contact_id
WHERE ct.user_id = ? AND c.via_contact_uri_hash = ? AND ct.contact_status = ? AND ct.deleted = 0
ORDER BY c.created_at DESC
LIMIT 1
|]
(userId, cReqHash, CSActive)
createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> IO PendingContactConnection
createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode = do
createdAt <- getCurrentTime

43
src/Simplex/Chat/Store/Groups.hs
View file

@ -31,9 +31,12 @@ module Simplex.Chat.Store.Groups
getGroupAndMember,
createNewGroup,
createGroupInvitation,
setViaGroupLinkHash,
setGroupInvitationChatItemId,
getGroup,
getGroupInfo,
getGroupInfoByUserContactLinkConnReq,
getGroupInfoByGroupLinkHash,
updateGroupProfile,
getGroupIdByName,
getGroupMemberIdByName,
@ -405,6 +408,17 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me
)
pure $ Right incognitoLdn
setViaGroupLinkHash :: DB.Connection -> GroupId -> Int64 -> IO ()
setViaGroupLinkHash db groupId connId =
DB.execute
db
[sql|
UPDATE groups
SET via_group_link_uri_hash = (SELECT via_contact_uri_hash FROM connections WHERE connection_id = ?)
WHERE group_id = ?
|]
(connId, groupId)
setGroupInvitationChatItemId :: DB.Connection -> User -> GroupId -> ChatItemId -> IO ()
setGroupInvitationChatItemId db User {userId} groupId chatItemId = do
currentTs <- getCurrentTime
@ -1102,6 +1116,35 @@ getGroupInfo db User {userId, userContactId} groupId =
|]
(groupId, userId, userContactId)
getGroupInfoByUserContactLinkConnReq :: DB.Connection -> User -> ConnReqContact -> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq db user cReq = do
groupId_ <- maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT group_id
FROM user_contact_links
WHERE conn_req_contact = ?
|]
(Only cReq)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db user) groupId_
getGroupInfoByGroupLinkHash :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe GroupInfo)
getGroupInfoByGroupLinkHash db user@User {userId, userContactId} groupLinkHash = do
groupId_ <- maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT g.group_id
FROM groups g
JOIN group_members mu ON mu.group_id = g.group_id
WHERE g.user_id = ? AND g.via_group_link_uri_hash = ?
AND mu.contact_id = ? AND mu.member_status NOT IN (?,?,?)
LIMIT 1
|]
(userId, groupLinkHash, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db user) groupId_
getGroupIdByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupId
getGroupIdByName db User {userId} gName =
ExceptT . firstRow fromOnly (SEGroupNotFoundByName gName) $

4
src/Simplex/Chat/Store/Migrations.hs
View file

@ -83,6 +83,7 @@ import Simplex.Chat.Migrations.M20230913_member_contacts
import Simplex.Chat.Migrations.M20230914_member_probes
import Simplex.Chat.Migrations.M20230926_contact_status
import Simplex.Chat.Migrations.M20231002_conn_initiated
import Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@ -165,7 +166,8 @@ schemaMigrations =
("20230913_member_contacts", m20230913_member_contacts, Just down_m20230913_member_contacts),
("20230914_member_probes", m20230914_member_probes, Just down_m20230914_member_probes),
("20230926_contact_status", m20230926_contact_status, Just down_m20230926_contact_status),
("20231002_conn_initiated", m20231002_conn_initiated, Just down_m20231002_conn_initiated)
("20231002_conn_initiated", m20231002_conn_initiated, Just down_m20231002_conn_initiated),
("20231009_via_group_link_uri_hash", m20231009_via_group_link_uri_hash, Just down_m20231009_via_group_link_uri_hash)
]
-- | The list of migrations in ascending order by date

15
src/Simplex/Chat/Store/Profiles.hs
View file

@ -42,6 +42,7 @@ module Simplex.Chat.Store.Profiles
deleteUserAddress,
getUserAddress,
getUserContactLinkById,
getUserContactLinkByConnReq,
updateUserAddressAutoAccept,
getProtocolServers,
overwriteProtocolServers,
@ -86,7 +87,7 @@ import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode)
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (safeDecodeUtf8)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User
createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime
@ -440,6 +441,18 @@ getUserContactLinkById db userId userContactLinkId =
|]
(userId, userContactLinkId)
getUserContactLinkByConnReq :: DB.Connection -> ConnReqContact -> IO (Maybe UserContactLink)
getUserContactLinkByConnReq db cReq =
maybeFirstRow toUserContactLink $
DB.query
db
[sql|
SELECT conn_req_contact, auto_accept, auto_accept_incognito, auto_reply_msg_content
FROM user_contact_links
WHERE conn_req_contact = ?
|]
(Only cReq)
updateUserAddressAutoAccept :: DB.Connection -> User -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink
updateUserAddressAutoAccept db user@User {userId} autoAccept = do
link <- getUserAddress db user

6
src/Simplex/Chat/Types.hs
View file

@ -206,6 +206,9 @@ directOrUsed ct@Contact {contactUsed} =
anyDirectOrUsed :: Contact -> Bool
anyDirectOrUsed Contact {contactUsed, activeConn = Connection {connLevel}} = connLevel == 0 || contactUsed
contactReady :: Contact -> Bool
contactReady Contact {activeConn} = connReady activeConn
contactActive :: Contact -> Bool
contactActive Contact {contactStatus} = contactStatus == CSActive
@ -1244,6 +1247,9 @@ data Connection = Connection
}
deriving (Eq, Show, Generic)
connReady :: Connection -> Bool
connReady Connection {connStatus} = connStatus == ConnReady || connStatus == ConnSndReady
authErrDisableCount :: Int
authErrDisableCount = 10

37
src/Simplex/Chat/View.hs
View file

@ -148,6 +148,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
CRVersionInfo info _ _ -> viewVersionInfo logLevel info
CRInvitation u cReq _ -> ttyUser u $ viewConnReqInvitation cReq
CRConnectionIncognitoUpdated u c -> ttyUser u $ viewConnectionIncognitoUpdated c
CRConnectionPlan u connectionPlan -> ttyUser u $ viewConnectionPlan connectionPlan
CRSentConfirmation u -> ttyUser u ["confirmation sent!"]
CRSentInvitation u customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"]
@ -1223,6 +1224,41 @@ viewConnectionIncognitoUpdated PendingContactConnection {pccConnId, customUserPr
| isJust customUserProfileId = ["connection " <> sShow pccConnId <> " changed to incognito"]
| otherwise = ["connection " <> sShow pccConnId <> " changed to non incognito"]
viewConnectionPlan :: ConnectionPlan -> [StyledString]
viewConnectionPlan = \case
CPInvitationLink ilp -> case ilp of
ILPOk -> [invLink "ok to connect"]
ILPOwnLink -> [invLink "own link"]
ILPConnecting Nothing -> [invLink "connecting"]
ILPConnecting (Just ct) -> [invLink ("connecting to contact " <> ttyContact' ct)]
ILPKnown ct ->
[ invLink ("known contact " <> ttyContact' ct),
"use " <> ttyToContact' ct <> highlight' "<message>" <> " to send messages"
]
where
invLink = ("invitation link: " <>)
CPContactAddress cap -> case cap of
CAPOk -> [ctAddr "ok to connect"]
CAPOwnLink -> [ctAddr "own address"]
CAPConnecting ct -> [ctAddr ("connecting to contact " <> ttyContact' ct)]
CAPKnown ct ->
[ ctAddr ("known contact " <> ttyContact' ct),
"use " <> ttyToContact' ct <> highlight' "<message>" <> " to send messages"
]
where
ctAddr = ("contact address: " <>)
CPGroupLink glp -> case glp of
GLPOk -> [grpLink "ok to connect"]
GLPOwnLink g -> [grpLink "own link for group " <> ttyGroup' g]
GLPConnecting Nothing -> [grpLink "connecting"]
GLPConnecting (Just g) -> [grpLink ("connecting to group " <> ttyGroup' g)]
GLPKnown g ->
[ grpLink ("known group " <> ttyGroup' g),
"use " <> ttyToGroup g <> highlight' "<message>" <> " to send messages"
]
where
grpLink = ("group link: " <>)
viewContactUpdated :: Contact -> Contact -> [StyledString]
viewContactUpdated
Contact {localDisplayName = n, profile = LocalProfile {fullName, contactLink}}
@ -1565,6 +1601,7 @@ viewChatError logLevel = \case
CEChatNotStarted -> ["error: chat not started"]
CEChatNotStopped -> ["error: chat not stopped"]
CEChatStoreChanged -> ["error: chat store changed, please restart chat"]
CEConnectionPlan connectionPlan -> viewConnectionPlan connectionPlan
CEInvalidConnReq -> viewInvalidConnReq
CEInvalidChatMessage Connection {connId} msgMeta_ msg e ->
[ plain $

67
tests/ChatTests/Direct.hs
View file

@ -44,6 +44,10 @@ chatDirectTests = do
describe "duplicate contacts" $ do
it "duplicate contacts are separate (contacts don't merge)" testDuplicateContactsSeparate
it "new contact is separate with multiple duplicate contacts (contacts don't merge)" testDuplicateContactsMultipleSeparate
describe "invitation link connection plan" $ do
it "invitation link ok to connect" testPlanInvitationLinkOk
it "own invitation link" testPlanInvitationLinkOwn
it "connecting via invitation link" testPlanInvitationLinkConnecting
describe "SMP servers" $ do
it "get and set SMP servers" testGetSetSMPServers
it "test SMP server connection" testTestSMPServerConnection
@ -236,6 +240,69 @@ testDuplicateContactsMultipleSeparate =
alice `hasContactProfiles` ["alice", "bob", "bob", "bob"]
bob `hasContactProfiles` ["bob", "alice", "alice", "alice"]
testPlanInvitationLinkOk :: HasCallStack => FilePath -> IO ()
testPlanInvitationLinkOk =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/c"
inv <- getInvitation alice
bob ##> ("/_connect plan 1 " <> inv)
bob <## "invitation link: ok to connect"
bob ##> ("/c " <> inv)
bob <## "confirmation sent!"
concurrently_
(alice <## "bob (Bob): contact is connected")
(bob <## "alice (Alice): contact is connected")
bob ##> ("/_connect plan 1 " <> inv)
bob <## "invitation link: ok to connect" -- conn_req_inv is forgotten after connection
alice <##> bob
testPlanInvitationLinkOwn :: HasCallStack => FilePath -> IO ()
testPlanInvitationLinkOwn tmp =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/c"
inv <- getInvitation alice
alice ##> ("/_connect plan 1 " <> inv)
alice <## "invitation link: own link"
alice ##> ("/c " <> inv)
alice <## "confirmation sent!"
alice
<### [ "alice_1 (Alice): contact is connected",
"alice_2 (Alice): contact is connected"
]
alice ##> ("/_connect plan 1 " <> inv)
alice <## "invitation link: ok to connect" -- conn_req_inv is forgotten after connection
alice @@@ [("@alice_1", lastChatFeature), ("@alice_2", lastChatFeature)]
alice `send` "@alice_2 hi"
alice
<### [ WithTime "@alice_2 hi",
WithTime "alice_1> hi"
]
alice `send` "@alice_1 hey"
alice
<### [ WithTime "@alice_1 hey",
WithTime "alice_2> hey"
]
alice @@@ [("@alice_1", "hey"), ("@alice_2", "hey")]
testPlanInvitationLinkConnecting :: HasCallStack => FilePath -> IO ()
testPlanInvitationLinkConnecting tmp = do
inv <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/c"
getInvitation alice
withNewTestChat tmp "bob" bobProfile $ \bob -> do
bob ##> ("/c " <> inv)
bob <## "confirmation sent!"
bob ##> ("/_connect plan 1 " <> inv)
bob <## "invitation link: connecting"
testContactClear :: HasCallStack => FilePath -> IO ()
testContactClear =
testChat2 aliceProfile bobProfile $

237
tests/ChatTests/Groups.hs
View file

@ -57,6 +57,12 @@ chatGroupTests = do
it "leaving groups with unused host contacts deletes incognito profiles" testGroupLinkIncognitoUnusedHostContactsDeleted
it "group link member role" testGroupLinkMemberRole
it "leaving and deleting the group joined via link should NOT delete previously existing direct contacts" testGroupLinkLeaveDelete
describe "group link connection plan" $ do
it "group link ok to connect; known group" testPlanGroupLinkOkKnown
it "group is known if host contact was deleted" testPlanHostContactDeletedGroupLinkKnown
it "own group link" testPlanGroupLinkOwn
it "connecting via group link" testPlanGroupLinkConnecting
it "re-join existing group after leaving" testPlanGroupLinkLeaveRejoin
describe "group message errors" $ do
it "show message decryption error" testGroupMsgDecryptError
it "should report ratchet de-synchronization, synchronize ratchets" testGroupSyncRatchet
@ -2251,6 +2257,237 @@ testGroupLinkLeaveDelete =
bob <## "alice (Alice)"
bob <## "cath (Catherine)"
testPlanGroupLinkOkKnown :: HasCallStack => FilePath -> IO ()
testPlanGroupLinkOkKnown =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
gLink <- getGroupLink alice "team" GRMember True
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: ok to connect"
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
alice <## "bob (Bob): accepting request to join group #team..."
concurrentlyN_
[ do
alice <## "bob (Bob): contact is connected"
alice <## "bob invited to group #team via your group link"
alice <## "#team: bob joined the group",
do
bob <## "alice (Alice): contact is connected"
bob <## "#team: you joined the group"
]
alice #> "#team hi"
bob <# "#team alice> hi"
bob #> "#team hey"
alice <# "#team bob> hey"
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: known group #team"
bob <## "use #team <message> to send messages"
bob ##> ("/c " <> gLink)
bob <## "group link: known group #team"
bob <## "use #team <message> to send messages"
testPlanHostContactDeletedGroupLinkKnown :: HasCallStack => FilePath -> IO ()
testPlanHostContactDeletedGroupLinkKnown =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
gLink <- getGroupLink alice "team" GRMember True
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
alice <## "bob (Bob): accepting request to join group #team..."
concurrentlyN_
[ do
alice <## "bob (Bob): contact is connected"
alice <## "bob invited to group #team via your group link"
alice <## "#team: bob joined the group",
do
bob <## "alice (Alice): contact is connected"
bob <## "#team: you joined the group"
]
alice #> "#team hi"
bob <# "#team alice> hi"
bob #> "#team hey"
alice <# "#team bob> hey"
alice <##> bob
threadDelay 500000
bob ##> "/d alice"
bob <## "alice: contact is deleted"
alice <## "bob (Bob) deleted contact with you"
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: known group #team"
bob <## "use #team <message> to send messages"
bob ##> ("/c " <> gLink)
bob <## "group link: known group #team"
bob <## "use #team <message> to send messages"
testPlanGroupLinkOwn :: HasCallStack => FilePath -> IO ()
testPlanGroupLinkOwn tmp =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
gLink <- getGroupLink alice "team" GRMember True
alice ##> ("/_connect plan 1 " <> gLink)
alice <## "group link: own link for group #team"
alice ##> ("/c " <> gLink)
alice <## "connection request sent!"
alice <## "alice_1 (Alice): accepting request to join group #team..."
alice
<### [ "alice_1 (Alice): contact is connected",
"alice_1 invited to group #team via your group link",
"#team: alice_1 joined the group",
"alice_2 (Alice): contact is connected",
"#team_1: you joined the group",
"contact alice_2 is merged into alice_1",
"use @alice_1 <message> to send messages"
]
alice `send` "#team 1"
alice
<### [ WithTime "#team 1",
WithTime "#team_1 alice_1> 1"
]
alice `send` "#team_1 2"
alice
<### [ WithTime "#team_1 2",
WithTime "#team alice_1> 2"
]
alice ##> ("/_connect plan 1 " <> gLink)
alice <## "group link: own link for group #team"
-- group works if merged contact is deleted
alice ##> "/d alice_1"
alice <## "alice_1: contact is deleted"
alice `send` "#team 3"
alice
<### [ WithTime "#team 3",
WithTime "#team_1 alice_1> 3"
]
alice `send` "#team_1 4"
alice
<### [ WithTime "#team_1 4",
WithTime "#team alice_1> 4"
]
testPlanGroupLinkConnecting :: HasCallStack => FilePath -> IO ()
testPlanGroupLinkConnecting tmp = do
gLink <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
getGroupLink alice "team" GRMember True
withNewTestChat tmp "bob" bobProfile $ \bob -> do
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
withTestChat tmp "alice" $ \alice -> do
alice
<### [ "1 group links active",
"#team: group is empty",
"bob (Bob): accepting request to join group #team..."
]
withTestChat tmp "bob" $ \bob -> do
threadDelay 500000
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: connecting"
bob ##> ("/c " <> gLink)
bob <## "group link: connecting"
testPlanGroupLinkLeaveRejoin :: HasCallStack => FilePath -> IO ()
testPlanGroupLinkLeaveRejoin =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
gLink <- getGroupLink alice "team" GRMember True
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
alice <## "bob (Bob): accepting request to join group #team..."
concurrentlyN_
[ do
alice <## "bob (Bob): contact is connected"
alice <## "bob invited to group #team via your group link"
alice <## "#team: bob joined the group",
do
bob <## "alice (Alice): contact is connected"
bob <## "#team: you joined the group"
]
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: known group #team"
bob <## "use #team <message> to send messages"
bob ##> ("/c " <> gLink)
bob <## "group link: known group #team"
bob <## "use #team <message> to send messages"
bob ##> "/leave #team"
concurrentlyN_
[ do
bob <## "#team: you left the group"
bob <## "use /d #team to delete the group",
alice <## "#team: bob left the group"
]
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: ok to connect"
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
alice <## "bob_1 (Bob): accepting request to join group #team..."
concurrentlyN_
[ alice
<### [ "bob_1 (Bob): contact is connected",
"bob_1 invited to group #team via your group link",
EndsWith "joined the group",
"contact bob_1 is merged into bob",
"use @bob <message> to send messages"
],
bob
<### [ "alice_1 (Alice): contact is connected",
"#team_1: you joined the group",
"contact alice_1 is merged into alice",
"use @alice <message> to send messages"
]
]
alice #> "#team hi"
bob <# "#team_1 alice> hi"
bob #> "#team_1 hey"
alice <# "#team bob> hey"
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: known group #team_1"
bob <## "use #team_1 <message> to send messages"
bob ##> ("/c " <> gLink)
bob <## "group link: known group #team_1"
bob <## "use #team_1 <message> to send messages"
testGroupMsgDecryptError :: HasCallStack => FilePath -> IO ()
testGroupMsgDecryptError tmp =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do

165
tests/ChatTests/Profiles.hs
View file

@ -28,6 +28,11 @@ chatProfileTests = do
it "delete connection requests when contact link deleted" testDeleteConnectionRequests
it "auto-reply message" testAutoReplyMessage
it "auto-reply message in incognito" testAutoReplyMessageInIncognito
describe "contact address connection plan" $ do
it "contact address ok to connect; known contact" testPlanAddressOkKnown
it "own contact address" testPlanAddressOwn
it "connecting via contact address" testPlanAddressConnecting
it "re-connect with deleted contact" testPlanAddressContactDeletedReconnected
describe "incognito" $ do
it "connect incognito via invitation link" testConnectIncognitoInvitationLink
it "connect incognito via contact address" testConnectIncognitoContactAddress
@ -369,7 +374,8 @@ testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $
(alice <## "bob (Bob): contact is connected")
bob ##> ("/c " <> cLink)
bob <## "alice (Alice): contact already exists"
bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages"
alice @@@ [("@bob", lastChatFeature)]
bob @@@ [("@alice", lastChatFeature), (":2", ""), (":1", "")]
bob ##> "/_delete :1"
@ -382,7 +388,8 @@ testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $
bob @@@ [("@alice", "hey")]
bob ##> ("/c " <> cLink)
bob <## "alice (Alice): contact already exists"
bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages"
alice <##> bob
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "hi"), (0, "hey"), (1, "hi"), (0, "hey")])
@ -440,7 +447,8 @@ testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile
(alice <## "robert (Robert): contact is connected")
bob ##> ("/c " <> cLink)
bob <## "alice (Alice): contact already exists"
bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages"
alice @@@ [("@robert", lastChatFeature)]
bob @@@ [("@alice", lastChatFeature), (":3", ""), (":2", ""), (":1", "")]
bob ##> "/_delete :1"
@ -455,7 +463,8 @@ testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile
bob @@@ [("@alice", "hey")]
bob ##> ("/c " <> cLink)
bob <## "alice (Alice): contact already exists"
bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages"
alice <##> bob
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "hi"), (0, "hey"), (1, "hi"), (0, "hey")])
@ -566,6 +575,154 @@ testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $
]
]
testPlanAddressOkKnown :: HasCallStack => FilePath -> IO ()
testPlanAddressOkKnown =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/ad"
cLink <- getContactLink alice True
bob ##> ("/_connect plan 1 " <> cLink)
bob <## "contact address: ok to connect"
bob ##> ("/c " <> cLink)
alice <#? bob
alice @@@ [("<@bob", "")]
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request..."
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
alice <##> bob
bob ##> ("/_connect plan 1 " <> cLink)
bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages"
bob ##> ("/c " <> cLink)
bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages"
testPlanAddressOwn :: HasCallStack => FilePath -> IO ()
testPlanAddressOwn tmp =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/ad"
cLink <- getContactLink alice True
alice ##> ("/_connect plan 1 " <> cLink)
alice <## "contact address: own address"
alice ##> ("/c " <> cLink)
alice <## "connection request sent!"
alice <## "alice_1 (Alice) wants to connect to you!"
alice <## "to accept: /ac alice_1"
alice <## ("to reject: /rc alice_1 (the sender will NOT be notified)")
alice @@@ [("<@alice_1", ""), (":2","")]
alice ##> "/ac alice_1"
alice <## "alice_1 (Alice): accepting contact request..."
alice
<### [ "alice_1 (Alice): contact is connected",
"alice_2 (Alice): contact is connected"
]
alice @@@ [("@alice_1", lastChatFeature), ("@alice_2", lastChatFeature)]
alice `send` "@alice_2 hi"
alice
<### [ WithTime "@alice_2 hi",
WithTime "alice_1> hi"
]
alice `send` "@alice_1 hey"
alice
<### [ WithTime "@alice_1 hey",
WithTime "alice_2> hey"
]
alice @@@ [("@alice_1", "hey"), ("@alice_2", "hey")]
alice ##> ("/_connect plan 1 " <> cLink)
alice <## "contact address: own address"
alice ##> ("/c " <> cLink)
alice <## "alice_2 (Alice): contact already exists"
testPlanAddressConnecting :: HasCallStack => FilePath -> IO ()
testPlanAddressConnecting tmp = do
cLink <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/ad"
getContactLink alice True
withNewTestChat tmp "bob" bobProfile $ \bob -> do
bob ##> ("/c " <> cLink)
bob <## "connection request sent!"
withTestChat tmp "alice" $ \alice -> do
alice <## "Your address is active! To show: /sa"
alice <## "bob (Bob) wants to connect to you!"
alice <## "to accept: /ac bob"
alice <## "to reject: /rc bob (the sender will NOT be notified)"
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request..."
withTestChat tmp "bob" $ \bob -> do
threadDelay 500000
bob @@@ [("@alice", "")]
bob ##> ("/_connect plan 1 " <> cLink)
bob <## "contact address: connecting to contact alice"
bob ##> ("/c " <> cLink)
bob <## "contact address: connecting to contact alice"
testPlanAddressContactDeletedReconnected :: HasCallStack => FilePath -> IO ()
testPlanAddressContactDeletedReconnected =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/ad"
cLink <- getContactLink alice True
bob ##> ("/c " <> cLink)
alice <#? bob
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request..."
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
alice <##> bob
bob ##> ("/_connect plan 1 " <> cLink)
bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages"
bob ##> ("/c " <> cLink)
bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages"
alice ##> "/d bob"
alice <## "bob: contact is deleted"
bob <## "alice (Alice) deleted contact with you"
bob ##> ("/_connect plan 1 " <> cLink)
bob <## "contact address: ok to connect"
bob ##> ("/c " <> cLink)
bob <## "connection request sent!"
alice <## "bob (Bob) wants to connect to you!"
alice <## "to accept: /ac bob"
alice <## "to reject: /rc bob (the sender will NOT be notified)"
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request..."
concurrently_
(bob <## "alice_1 (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
alice #> "@bob hi"
bob <# "alice_1> hi"
bob #> "@alice_1 hey"
alice <# "bob> hey"
bob ##> ("/_connect plan 1 " <> cLink)
bob <## "contact address: known contact alice_1"
bob <## "use @alice_1 <message> to send messages"
bob ##> ("/c " <> cLink)
bob <## "contact address: known contact alice_1"
bob <## "use @alice_1 <message> to send messages"
testConnectIncognitoInvitationLink :: HasCallStack => FilePath -> IO ()
testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do