core: preset simplex contact (#3321)
This commit is contained in:
spaced4ndy
GitHub
parent
b33fe01e49
commit
a04dc5d05b
@ -119,6 +119,7 @@ library
|
||||
Simplex.Chat.Migrations.M20231010_member_settings
|
||||
Simplex.Chat.Migrations.M20231019_indexes
|
||||
Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
|
||||
Simplex.Chat.Migrations.M20231107_indexes
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Mobile.File
|
||||
Simplex.Chat.Mobile.Shared
|
||||
|
||||
@ -406,6 +406,7 @@ processChatCommand = \case
|
||||
withAgent (\a -> createUser a smp xftp)
|
||||
ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure
|
||||
user <- withStore $ \db -> createUserRecordAt db (AgentUserId auId) p True ts
|
||||
when (auId == 1) $ withStore (\db -> createContact db user simplexContactProfile) `catchChatError` \_ -> pure ()
|
||||
storeServers user smpServers
|
||||
storeServers user xftpServers
|
||||
atomically . writeTVar u $ Just user
|
||||
@ -1391,13 +1392,25 @@ processChatCommand = \case
|
||||
Connect incognito aCReqUri@(Just cReqUri) -> withUser $ \user@User {userId} -> do
|
||||
plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk)
|
||||
unless (connectionPlanProceed plan) $ throwChatError (CEConnectionPlan plan)
|
||||
processChatCommand $ APIConnect userId incognito aCReqUri
|
||||
case plan of
|
||||
CPContactAddress (CAPContactViaAddress Contact {contactId}) ->
|
||||
processChatCommand $ APIConnectContactViaAddress userId incognito contactId
|
||||
_ -> processChatCommand $ APIConnect userId incognito aCReqUri
|
||||
Connect _ Nothing -> throwChatError CEInvalidConnReq
|
||||
APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do
|
||||
ct@Contact {activeConn, profile = LocalProfile {contactLink}} <- withStore $ \db -> getContact db user contactId
|
||||
when (isJust activeConn) $ throwChatError (CECommandError "contact already has connection")
|
||||
case contactLink of
|
||||
Just cReq -> connectContactViaAddress user incognito ct cReq
|
||||
Nothing -> throwChatError (CECommandError "no address in contact profile")
|
||||
ConnectSimplex incognito -> withUser $ \user@User {userId} -> do
|
||||
let cReqUri = ACR SCMContact adminContactReq
|
||||
plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk)
|
||||
unless (connectionPlanProceed plan) $ throwChatError (CEConnectionPlan plan)
|
||||
processChatCommand $ APIConnect userId incognito (Just cReqUri)
|
||||
case plan of
|
||||
CPContactAddress (CAPContactViaAddress Contact {contactId}) ->
|
||||
processChatCommand $ APIConnectContactViaAddress userId incognito contactId
|
||||
_ -> 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 ->
|
||||
@ -2022,15 +2035,27 @@ processChatCommand = \case
|
||||
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
|
||||
(connId, incognitoProfile, subMode) <- requestContact user incognito cReq xContactId
|
||||
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode
|
||||
toView $ CRNewContactConnection user conn
|
||||
pure $ CRSentInvitation user incognitoProfile
|
||||
connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> m ChatResponse
|
||||
connectContactViaAddress user incognito ct cReq =
|
||||
withChatLock "connectViaContact" $ do
|
||||
newXContactId <- XContactId <$> drgRandomBytes 16
|
||||
(connId, incognitoProfile, subMode) <- requestContact user incognito cReq newXContactId
|
||||
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
|
||||
ct' <- withStore $ \db -> createAddressContactConnection db user ct connId cReqHash newXContactId incognitoProfile subMode
|
||||
pure $ CRSentInvitationToContact user ct' incognitoProfile
|
||||
requestContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> XContactId -> m (ConnId, Maybe Profile, SubscriptionMode)
|
||||
requestContact user incognito cReq 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
|
||||
pure (connId, incognitoProfile, subMode)
|
||||
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
|
||||
contactMember Contact {contactId} =
|
||||
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
|
||||
@ -2283,9 +2308,12 @@ processChatCommand = \case
|
||||
Nothing ->
|
||||
withStore' (\db -> getUserContactLinkByConnReq db user cReqSchemas) >>= \case
|
||||
Just _ -> pure $ CPContactAddress CAPOwnLink
|
||||
Nothing -> do
|
||||
Nothing ->
|
||||
withStore' (\db -> getContactConnEntityByConnReqHash db user cReqHashes) >>= \case
|
||||
Nothing -> pure $ CPContactAddress CAPOk
|
||||
Nothing ->
|
||||
withStore' (\db -> getContactWithoutConnViaAddress db user cReqSchemas) >>= \case
|
||||
Nothing -> pure $ CPContactAddress CAPOk
|
||||
Just ct -> pure $ CPContactAddress (CAPContactViaAddress ct)
|
||||
Just (RcvDirectMsgConnection _conn Nothing) -> pure $ CPContactAddress CAPConnectingConfirmReconnect
|
||||
Just (RcvDirectMsgConnection _ (Just ct))
|
||||
| not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnectingProhibit ct)
|
||||
@ -5880,6 +5908,7 @@ chatCommandP =
|
||||
"/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal <*> optional (" encrypt=" *> onOffP)),
|
||||
("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal),
|
||||
("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal),
|
||||
"/_connect contact " *> (APIConnectContactViaAddress <$> A.decimal <*> incognitoOnOffP <* A.space <*> A.decimal),
|
||||
"/simplex" *> (ConnectSimplex <$> incognitoP),
|
||||
"/_address " *> (APICreateMyAddress <$> A.decimal),
|
||||
("/address" <|> "/ad") $> CreateMyAddress,
|
||||
@ -6041,6 +6070,15 @@ adminContactReq :: ConnReqContact
|
||||
adminContactReq =
|
||||
either error id $ strDecode "simplex:/contact#/?v=1&smp=smp%3A%2F%2FPQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo%3D%40smp6.simplex.im%2FK1rslx-m5bpXVIdMZg9NLUZ_8JBm8xTt%23MCowBQYDK2VuAyEALDeVe-sG8mRY22LsXlPgiwTNs9dbiLrNuA7f3ZMAJ2w%3D"
|
||||
|
||||
simplexContactProfile :: Profile
|
||||
simplexContactProfile = Profile {
|
||||
displayName = "SimpleX Chat team",
|
||||
fullName = "",
|
||||
image = Nothing,
|
||||
contactLink = Just adminContactReq,
|
||||
preferences = Nothing
|
||||
}
|
||||
|
||||
timeItToView :: ChatMonad' m => String -> m a -> m a
|
||||
timeItToView s action = do
|
||||
t1 <- liftIO getCurrentTime
|
||||
|
||||
@ -336,6 +336,7 @@ data ChatCommand
|
||||
| APIConnectPlan UserId AConnectionRequestUri
|
||||
| APIConnect UserId IncognitoEnabled (Maybe AConnectionRequestUri)
|
||||
| Connect IncognitoEnabled (Maybe AConnectionRequestUri)
|
||||
| APIConnectContactViaAddress UserId IncognitoEnabled ContactId
|
||||
| ConnectSimplex IncognitoEnabled -- UserId (not used in UI)
|
||||
| DeleteContact ContactName
|
||||
| ClearContact ContactName
|
||||
@ -489,6 +490,7 @@ data ChatResponse
|
||||
| CRConnectionPlan {user :: User, connectionPlan :: ConnectionPlan}
|
||||
| CRSentConfirmation {user :: User}
|
||||
| CRSentInvitation {user :: User, customUserProfile :: Maybe Profile}
|
||||
| CRSentInvitationToContact {user :: User, contact :: Contact, customUserProfile :: Maybe Profile}
|
||||
| CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
|
||||
| CRGroupMemberUpdated {user :: User, groupInfo :: GroupInfo, fromMember :: GroupMember, toMember :: GroupMember}
|
||||
| CRContactsMerged {user :: User, intoContact :: Contact, mergedContact :: Contact, updatedContact :: Contact}
|
||||
@ -653,6 +655,7 @@ data ContactAddressPlan
|
||||
| CAPConnectingConfirmReconnect
|
||||
| CAPConnectingProhibit {contact :: Contact}
|
||||
| CAPKnown {contact :: Contact}
|
||||
| CAPContactViaAddress {contact :: Contact}
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON ContactAddressPlan where
|
||||
@ -681,6 +684,7 @@ connectionPlanProceed = \case
|
||||
CAPOk -> True
|
||||
CAPOwnLink -> True
|
||||
CAPConnectingConfirmReconnect -> True
|
||||
CAPContactViaAddress _ -> True
|
||||
_ -> False
|
||||
CPGroupLink glp -> case glp of
|
||||
GLPOk -> True
|
||||
|
||||
18
src/Simplex/Chat/Migrations/M20231107_indexes.hs
Normal file
18
src/Simplex/Chat/Migrations/M20231107_indexes.hs
Normal file
@ -0,0 +1,18 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20231107_indexes where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20231107_indexes :: Query
|
||||
m20231107_indexes =
|
||||
[sql|
|
||||
CREATE INDEX idx_contact_profiles_contact_link ON contact_profiles(user_id, contact_link);
|
||||
|]
|
||||
|
||||
down_m20231107_indexes :: Query
|
||||
down_m20231107_indexes =
|
||||
[sql|
|
||||
DROP INDEX idx_contact_profiles_contact_link;
|
||||
|]
|
||||
@ -748,3 +748,7 @@ CREATE INDEX idx_connections_via_contact_uri_hash ON connections(
|
||||
user_id,
|
||||
via_contact_uri_hash
|
||||
);
|
||||
CREATE INDEX idx_contact_profiles_contact_link ON contact_profiles(
|
||||
user_id,
|
||||
contact_link
|
||||
);
|
||||
|
||||
@ -23,6 +23,7 @@ module Simplex.Chat.Store.Direct
|
||||
createDirectConnection,
|
||||
createIncognitoProfile,
|
||||
createConnReqConnection,
|
||||
createAddressContactConnection,
|
||||
getProfileById,
|
||||
getConnReqContactXContactId,
|
||||
getContactByConnReqHash,
|
||||
@ -119,6 +120,12 @@ deletePendingContactConnection db userId connId =
|
||||
|]
|
||||
(userId, connId, ConnContact)
|
||||
|
||||
createAddressContactConnection :: DB.Connection -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> ExceptT StoreError IO Contact
|
||||
createAddressContactConnection db user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode = do
|
||||
PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, pccConnId)
|
||||
getContact db user contactId
|
||||
|
||||
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> IO PendingContactConnection
|
||||
createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode = do
|
||||
createdAt <- getCurrentTime
|
||||
@ -195,12 +202,13 @@ createIncognitoProfile db User {userId} p = do
|
||||
|
||||
createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
|
||||
createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} = do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
(localDisplayName, contactId, profileId) <- createContact_ db userId connId p localAlias Nothing createdAt (Just createdAt)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
(localDisplayName, contactId, profileId) <- createContact_ db userId p localAlias Nothing currentTs (Just currentTs)
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
|
||||
let profile = toLocalProfile profileId p localAlias
|
||||
userPreferences = emptyChatPrefs
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
||||
pure $ Contact {contactId, localDisplayName, profile, activeConn = Just conn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
pure $ Contact {contactId, localDisplayName, profile, activeConn = Just conn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
|
||||
deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO ()
|
||||
deleteContactConnectionsAndFiles db userId Contact {contactId} = do
|
||||
@ -678,17 +686,20 @@ getContact_ db user@User {userId} contactId deleted =
|
||||
LEFT JOIN connections c ON c.contact_id = ct.contact_id
|
||||
WHERE ct.user_id = ? AND ct.contact_id = ?
|
||||
AND ct.deleted = ?
|
||||
AND c.connection_id = (
|
||||
SELECT cc_connection_id FROM (
|
||||
SELECT
|
||||
cc.connection_id AS cc_connection_id,
|
||||
cc.created_at AS cc_created_at,
|
||||
(CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
|
||||
FROM connections cc
|
||||
WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
|
||||
ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
|
||||
LIMIT 1
|
||||
AND (
|
||||
c.connection_id = (
|
||||
SELECT cc_connection_id FROM (
|
||||
SELECT
|
||||
cc.connection_id AS cc_connection_id,
|
||||
cc.created_at AS cc_created_at,
|
||||
(CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
|
||||
FROM connections cc
|
||||
WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
|
||||
ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
|
||||
LIMIT 1
|
||||
)
|
||||
)
|
||||
OR c.connection_id IS NULL
|
||||
)
|
||||
|]
|
||||
(userId, contactId, deleted, ConnReady, ConnSndReady)
|
||||
|
||||
@ -1054,7 +1054,8 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM
|
||||
Just (directCmdId, directAgentConnId) -> do
|
||||
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode
|
||||
liftIO $ setCommandConnId db user directCmdId directConnId
|
||||
(localDisplayName, contactId, memProfileId) <- createContact_ db userId directConnId memberProfile "" (Just groupId) currentTs Nothing
|
||||
(localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs Nothing
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId)
|
||||
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Just contactId, memProfileId}
|
||||
Nothing -> do
|
||||
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs
|
||||
|
||||
@ -87,6 +87,7 @@ import Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash
|
||||
import Simplex.Chat.Migrations.M20231010_member_settings
|
||||
import Simplex.Chat.Migrations.M20231019_indexes
|
||||
import Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
|
||||
import Simplex.Chat.Migrations.M20231107_indexes
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@ -173,7 +174,8 @@ schemaMigrations =
|
||||
("20231009_via_group_link_uri_hash", m20231009_via_group_link_uri_hash, Just down_m20231009_via_group_link_uri_hash),
|
||||
("20231010_member_settings", m20231010_member_settings, Just down_m20231010_member_settings),
|
||||
("20231019_indexes", m20231019_indexes, Just down_m20231019_indexes),
|
||||
("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received)
|
||||
("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received),
|
||||
("20231107_indexes", m20231107_indexes, Just down_m20231107_indexes)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@ -4,6 +4,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
@ -43,6 +44,7 @@ module Simplex.Chat.Store.Profiles
|
||||
getUserAddress,
|
||||
getUserContactLinkById,
|
||||
getUserContactLinkByConnReq,
|
||||
getContactWithoutConnViaAddress,
|
||||
updateUserAddressAutoAccept,
|
||||
getProtocolServers,
|
||||
overwriteProtocolServers,
|
||||
@ -87,7 +89,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 (safeDecodeUtf8, eitherToMaybe)
|
||||
|
||||
createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User
|
||||
createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime
|
||||
@ -453,6 +455,21 @@ getUserContactLinkByConnReq db User {userId} (cReqSchema1, cReqSchema2) =
|
||||
|]
|
||||
(userId, cReqSchema1, cReqSchema2)
|
||||
|
||||
getContactWithoutConnViaAddress :: DB.Connection -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
|
||||
getContactWithoutConnViaAddress db user@User {userId} (cReqSchema1, cReqSchema2) = do
|
||||
ctId_ <- maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT ct.contact_id
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
|
||||
LEFT JOIN connections c ON c.contact_id = ct.contact_id
|
||||
WHERE cp.user_id = ? AND cp.contact_link IN (?,?) AND c.connection_id IS NULL
|
||||
|]
|
||||
(userId, cReqSchema1, cReqSchema2)
|
||||
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) ctId_
|
||||
|
||||
updateUserAddressAutoAccept :: DB.Connection -> User -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink
|
||||
updateUserAddressAutoAccept db user@User {userId} autoAccept = do
|
||||
link <- getUserAddress db user
|
||||
|
||||
@ -218,8 +218,13 @@ setCommandConnId db User {userId} cmdId connId = do
|
||||
|]
|
||||
(connId, updatedAt, userId, cmdId)
|
||||
|
||||
createContact_ :: DB.Connection -> UserId -> Int64 -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> Maybe UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
|
||||
createContact_ db userId connId Profile {displayName, fullName, image, contactLink, preferences} localAlias viaGroup currentTs chatTs =
|
||||
createContact :: DB.Connection -> User -> Profile -> ExceptT StoreError IO ()
|
||||
createContact db User {userId} profile = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
void $ createContact_ db userId profile "" Nothing currentTs Nothing
|
||||
|
||||
createContact_ :: DB.Connection -> UserId -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> Maybe UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
|
||||
createContact_ db userId Profile {displayName, fullName, image, contactLink, preferences} localAlias viaGroup currentTs chatTs =
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
|
||||
DB.execute
|
||||
db
|
||||
@ -231,7 +236,6 @@ createContact_ db userId connId Profile {displayName, fullName, image, contactLi
|
||||
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?)"
|
||||
(profileId, ldn, userId, viaGroup, currentTs, currentTs, chatTs)
|
||||
contactId <- insertedRowId db
|
||||
DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
|
||||
pure $ Right (ldn, contactId, profileId)
|
||||
|
||||
deleteUnusedIncognitoProfileById_ :: DB.Connection -> User -> ProfileId -> IO ()
|
||||
|
||||
@ -153,6 +153,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
|
||||
CRConnectionPlan u connectionPlan -> ttyUser u $ viewConnectionPlan connectionPlan
|
||||
CRSentConfirmation u -> ttyUser u ["confirmation sent!"]
|
||||
CRSentInvitation u customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
|
||||
CRSentInvitationToContact u _c customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
|
||||
CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"]
|
||||
CRContactDeletedByContact u c -> ttyUser u [ttyFullContact c <> " deleted contact with you"]
|
||||
CRChatCleared u chatInfo -> ttyUser u $ viewChatCleared chatInfo
|
||||
@ -1309,6 +1310,7 @@ viewConnectionPlan = \case
|
||||
[ ctAddr ("known contact " <> ttyContact' ct),
|
||||
"use " <> ttyToContact' ct <> highlight' "<message>" <> " to send messages"
|
||||
]
|
||||
CAPContactViaAddress ct -> [ctAddr ("known contact without connection " <> ttyContact' ct)]
|
||||
where
|
||||
ctAddr = ("contact address: " <>)
|
||||
CPGroupLink glp -> case glp of
|
||||
|
||||
@ -7,10 +7,16 @@ import ChatClient
|
||||
import ChatTests.Utils
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Concurrent.Async (concurrently_)
|
||||
import Control.Monad.Except
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.Text as T
|
||||
import Simplex.Chat.Types (ConnStatus (..), GroupMemberRole (..), Profile (..))
|
||||
import System.Directory (copyFile, createDirectoryIfMissing)
|
||||
import Test.Hspec
|
||||
import Simplex.Chat.Store.Shared (createContact)
|
||||
import Control.Monad
|
||||
import Simplex.Messaging.Encoding.String (StrEncoding(..))
|
||||
|
||||
chatProfileTests :: SpecWith FilePath
|
||||
chatProfileTests = do
|
||||
@ -33,6 +39,7 @@ chatProfileTests = do
|
||||
it "own contact address" testPlanAddressOwn
|
||||
it "connecting via contact address" testPlanAddressConnecting
|
||||
it "re-connect with deleted contact" testPlanAddressContactDeletedReconnected
|
||||
it "contact via address" testPlanAddressContactViaAddress
|
||||
describe "incognito" $ do
|
||||
it "connect incognito via invitation link" testConnectIncognitoInvitationLink
|
||||
it "connect incognito via contact address" testConnectIncognitoContactAddress
|
||||
@ -755,6 +762,60 @@ testPlanAddressContactDeletedReconnected =
|
||||
bob <## "contact address: known contact alice_1"
|
||||
bob <## "use @alice_1 <message> to send messages"
|
||||
|
||||
testPlanAddressContactViaAddress :: HasCallStack => FilePath -> IO ()
|
||||
testPlanAddressContactViaAddress =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/ad"
|
||||
cLink <- getContactLink alice True
|
||||
|
||||
alice ##> "/pa on" -- not necessary, without it bob would receive profile update removing contact link
|
||||
alice <## "new contact address set"
|
||||
|
||||
case A.parseOnly strP (B.pack cLink) of
|
||||
Left _ -> error "error parsing contact link"
|
||||
Right cReq -> do
|
||||
let profile = aliceProfile {contactLink = Just cReq}
|
||||
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> runExceptT $ createContact db user profile
|
||||
bob @@@ [("@alice", "")]
|
||||
|
||||
bob ##> ("/_connect plan 1 " <> cLink)
|
||||
bob <## "contact address: known contact without connection alice"
|
||||
|
||||
let cLinkSchema2 = linkAnotherSchema cLink
|
||||
bob ##> ("/_connect plan 1 " <> cLinkSchema2)
|
||||
bob <## "contact address: known contact without connection alice"
|
||||
|
||||
-- terminal api
|
||||
bob ##> ("/c " <> cLink)
|
||||
connecting alice bob
|
||||
|
||||
bob ##> "/_delete @2 notify=off"
|
||||
bob <## "alice: contact is deleted"
|
||||
alice ##> "/_delete @2 notify=off"
|
||||
alice <## "bob: contact is deleted"
|
||||
|
||||
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> runExceptT $ createContact db user profile
|
||||
bob @@@ [("@alice", "")]
|
||||
|
||||
-- GUI api
|
||||
bob ##> "/_connect contact 1 2"
|
||||
connecting alice bob
|
||||
where
|
||||
connecting alice bob = do
|
||||
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 (Alice): contact is connected")
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
|
||||
alice <##> bob
|
||||
bob @@@ [("@alice", "hey")]
|
||||
|
||||
testConnectIncognitoInvitationLink :: HasCallStack => FilePath -> IO ()
|
||||
testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
||||
@ -435,6 +435,17 @@ getContactProfiles cc = do
|
||||
profiles <- withTransaction (chatStore $ chatController cc) $ \db -> getUserContactProfiles db user
|
||||
pure $ map (\Profile {displayName} -> displayName) profiles
|
||||
|
||||
withCCUser :: TestCC -> (User -> IO a) -> IO a
|
||||
withCCUser cc action = do
|
||||
user_ <- readTVarIO (currentUser $ chatController cc)
|
||||
case user_ of
|
||||
Nothing -> error "no user"
|
||||
Just user -> action user
|
||||
|
||||
withCCTransaction :: TestCC -> (DB.Connection -> IO a) -> IO a
|
||||
withCCTransaction cc action =
|
||||
withTransaction (chatStore $ chatController cc) $ \db -> action db
|
||||
|
||||
getProfilePictureByName :: TestCC -> String -> IO (Maybe String)
|
||||
getProfilePictureByName cc displayName =
|
||||
withTransaction (chatStore $ chatController cc) $ \db ->
|
||||
|
||||
Loading…
Reference in New Issue
Block a user