dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-04-25 14:12:27 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: set short links data, prepare entity, etc.; ios: connect to prepared contact (#5951)

Browse Source
This commit is contained in:
spaced4ndy
2025-06-04 07:47:10 +00:00
committed by GitHub
parent b4e48dac29
commit 8a4760a2cb
64 changed files with 1117 additions and 547 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
src/Simplex/Chat/Controller.hs
View File

@@ -448,12 +448,12 @@ data ChatCommand
| APISetConnectionIncognito Int64 IncognitoEnabled
| APIChangeConnectionUser Int64 UserId -- new user id to switch connection to
| APIConnectPlan UserId AConnectionLink
| APIPrepareContact UserId ContactShortLinkData ACreatedConnLink
| APIPrepareGroup UserId GroupShortLinkData ACreatedConnLink
| APIPrepareContact UserId ACreatedConnLink ContactShortLinkData
| APIPrepareGroup UserId ACreatedConnLink GroupShortLinkData
| APIChangeContactUser ContactId UserId
| APIChangeGroupUser GroupId UserId
| APIConnectPreparedContact {contactId :: ContactId, msgContent_ :: Maybe MsgContent}
| APIConnectPreparedGroup GroupId
| APIConnectPreparedContact {contactId :: ContactId, incognito :: IncognitoEnabled, msgContent_ :: Maybe MsgContent}
| APIConnectPreparedGroup GroupId IncognitoEnabled
| APIConnect UserId IncognitoEnabled (Maybe ACreatedConnLink) (Maybe MsgContent)
| Connect IncognitoEnabled (Maybe AConnectionLink)
| APIConnectContactViaAddress UserId IncognitoEnabled ContactId
@@ -683,8 +683,11 @@ data ChatResponse
| CRConnectionIncognitoUpdated {user :: User, toConnection :: PendingContactConnection}
| CRConnectionUserChanged {user :: User, fromConnection :: PendingContactConnection, toConnection :: PendingContactConnection, newUser :: User}
| CRConnectionPlan {user :: User, connLink :: ACreatedConnLink, connectionPlan :: ConnectionPlan}
| CRNewPreparedContact {user :: User, contact :: Contact}
| CRNewPreparedGroup {user :: User, groupInfo :: GroupInfo}
| CRSentConfirmation {user :: User, connection :: PendingContactConnection}
| CRSentInvitation {user :: User, connection :: PendingContactConnection, customUserProfile :: Maybe Profile}
| CRStartedConnectionToContact {user :: User, contact :: Contact}
| CRSentInvitationToContact {user :: User, contact :: Contact, customUserProfile :: Maybe Profile}
| CRItemsReadForChat {user :: User, chatInfo :: AChatInfo}
| CRContactDeleted {user :: User, contact :: Contact}

329
src/Simplex/Chat/Library/Commands.hs
View File

@@ -1267,6 +1267,7 @@ processChatCommand' vr = \case
APICallStatus contactId receivedStatus ->
withCurrentCall contactId $ \user ct call ->
updateCallItemStatus user ct call receivedStatus Nothing $> Just call
-- TODO [short links] update address short link data
APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile)
APISetContactPrefs contactId prefs' -> withUser $ \user -> do
ct <- withFastStore $ \db -> getContact db vr user contactId
@@ -1666,36 +1667,42 @@ processChatCommand' vr = \case
-- [incognito] generate profile for connection
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
subMode <- chatReadVar subscriptionMode
let userData = shortLinkUserData short
let userData =
if short
then Just $ encodeShortLinkData (ContactShortLinkData (userProfileToSend user incognitoProfile Nothing False) Nothing)
else Nothing
(connId, ccLink) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation userData Nothing IKPQOn subMode
ccLink' <- shortenCreatedLink ccLink
-- TODO PQ pass minVersion from the current range
conn <- withFastStore' $ \db -> createDirectConnection db user connId ccLink' ConnNew incognitoProfile subMode initialChatVersion PQSupportOn
conn <- withFastStore' $ \db -> createDirectConnection db user connId ccLink' Nothing ConnNew incognitoProfile subMode initialChatVersion PQSupportOn
pure $ CRInvitation user ccLink' conn
AddContact short incognito -> withUser $ \User {userId} ->
processChatCommand $ APIAddContact userId short incognito
APISetConnectionIncognito connId incognito -> withUser $ \user@User {userId} -> do
conn'_ <- withFastStore $ \db -> do
conn@PendingContactConnection {pccConnStatus, customUserProfileId} <- getPendingContactConnection db userId connId
case (pccConnStatus, customUserProfileId, incognito) of
(ConnNew, Nothing, True) -> liftIO $ do
incognitoProfile <- generateRandomProfile
conn <- withFastStore $ \db -> getPendingContactConnection db userId connId
let PendingContactConnection {pccConnStatus, customUserProfileId} = conn
case (pccConnStatus, customUserProfileId, incognito) of
(ConnNew, Nothing, True) -> do
incognitoProfile <- liftIO generateRandomProfile
sLnk <- updatePCCShortLinkData conn (ContactShortLinkData (userProfileToSend user (Just incognitoProfile) Nothing False) Nothing)
conn' <- withFastStore' $ \db -> do
pId <- createIncognitoProfile db user incognitoProfile
Just <$> updatePCCIncognito db user conn (Just pId)
(ConnNew, Just pId, False) -> liftIO $ do
updatePCCIncognito db user conn (Just pId) sLnk
pure $ CRConnectionIncognitoUpdated user conn'
(ConnNew, Just pId, False) -> do
sLnk <- updatePCCShortLinkData conn (ContactShortLinkData (userProfileToSend user Nothing Nothing False) Nothing)
conn' <- withFastStore' $ \db -> 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
updatePCCIncognito db user conn Nothing sLnk
pure $ CRConnectionIncognitoUpdated user conn'
_ -> throwChatError CEConnectionIncognitoChangeProhibited
APIChangeConnectionUser connId newUserId -> withUser $ \user@User {userId} -> do
conn <- withFastStore $ \db -> getPendingContactConnection db userId connId
let PendingContactConnection {pccConnStatus, connLinkInv} = conn
case (pccConnStatus, connLinkInv) of
(ConnNew, Just (CCLink cReqInv _)) -> do
newUser <- privateGetUser newUserId
conn' <- ifM (canKeepLink cReqInv newUser) (updateConnRecord user conn newUser) (recreateConn user conn newUser)
conn' <- ifM (canKeepLink cReqInv newUser) (updateConn user conn newUser) (recreateConn user conn newUser)
pure $ CRConnectionUserChanged user conn conn' newUser
_ -> throwChatError CEConnectionUserChangeProhibited
where
@@ -1707,39 +1714,44 @@ processChatCommand' vr = \case
map protoServer' . L.filter (\ServerCfg {enabled} -> enabled)
<$> getKnownAgentServers SPSMP newUser
pure $ smpServer `elem` newUserServers
updateConnRecord user@User {userId} conn@PendingContactConnection {customUserProfileId} newUser = do
updateConn user@User {userId} conn@PendingContactConnection {customUserProfileId} newUser = do
withAgent $ \a -> changeConnectionUser a (aUserId user) (aConnId' conn) (aUserId newUser)
sLnk <- updatePCCShortLinkData conn (ContactShortLinkData (userProfileToSend newUser Nothing Nothing False) Nothing)
withFastStore' $ \db -> do
conn' <- updatePCCUser db userId conn newUserId
conn' <- updatePCCUser db userId conn newUserId sLnk
forM_ customUserProfileId $ \profileId ->
deletePCCIncognitoProfile db user profileId
pure conn'
recreateConn user conn@PendingContactConnection {customUserProfileId, connLinkInv} newUser = do
subMode <- chatReadVar subscriptionMode
let userData = shortLinkUserData $ isJust $ connShortLink =<< connLinkInv
let short = isJust $ connShortLink =<< connLinkInv
userData =
if short
then Just $ encodeShortLinkData (ContactShortLinkData (userProfileToSend user Nothing Nothing False) Nothing)
else Nothing
(agConnId, ccLink) <- withAgent $ \a -> createConnection a (aUserId newUser) True SCMInvitation userData Nothing IKPQOn subMode
ccLink' <- shortenCreatedLink ccLink
conn' <- withFastStore' $ \db -> do
deleteConnectionRecord db user connId
forM_ customUserProfileId $ \profileId ->
deletePCCIncognitoProfile db user profileId
createDirectConnection db newUser agConnId ccLink' ConnNew Nothing subMode initialChatVersion PQSupportOn
createDirectConnection db newUser agConnId ccLink' Nothing ConnNew Nothing subMode initialChatVersion PQSupportOn
deleteAgentConnectionAsync (aConnId' conn)
pure conn'
APIConnectPlan userId cLink -> withUserId userId $ \user ->
uncurry (CRConnectionPlan user) <$> connectPlan user cLink
-- TODO [short links] prepare entity
-- TODO - UI would call these APIs after Ok connection plans with short link data
-- TODO - Persist ACreatedConnLink to be used for connection later on user action:
-- TODO - `link` to contacts.inv_conn_req_to_connect, contacts.addr_conn_req_to_connect, groups.conn_req_to_connect
-- TODO - prepared "invitation" and "address" contacts have to be differentiated,
-- TODO for example to warn user before deleting "invitation" contact, hence two fields
-- TODO - Alternatively, entity can be prepared without user action during Ok plans
-- TODO to avoid extra user action, then these APIs can be avoided altogether
APIPrepareContact userId contactSLinkData link -> withUserId userId $ \user -> do
ok_
APIPrepareGroup userId groupSLinkData link -> withUserId userId $ \user -> do
ok_
APIPrepareContact userId link contactSLinkData -> withUserId userId $ \user -> do
let ContactShortLinkData {profile, welcomeMsg} = contactSLinkData
ct <- withStore $ \db -> createPreparedContact db user profile link
forM_ welcomeMsg $ \msg ->
createInternalChatItem user (CDDirectRcv ct) (CIRcvMsgContent $ MCText msg) Nothing
pure $ CRNewPreparedContact user ct
APIPrepareGroup userId link groupSLinkData -> withUserId userId $ \user -> do
let GroupShortLinkData {groupProfile} = groupSLinkData
-- TODO [short link] create host member for group connection on CONF, XGrpLinkInv (as in createGroupViaLink')
-- TODO - see other problems in createPreparedGroup: invited member id (user member), business chats
gInfo <- withStore $ \db -> createPreparedGroup db vr user groupProfile link
pure $ CRNewPreparedGroup user gInfo
-- TODO [short links] change prepared entity user
-- TODO - UI would call these APIs before APIConnectPrepared... APIs
-- TODO - UI to transition to new user keeping chat opened
@@ -1747,61 +1759,47 @@ processChatCommand' vr = \case
ok_
APIChangeGroupUser groupId newUserId -> withUser $ \user -> do
ok_
-- TODO [short links] connect to prepared entity
-- TODO - UI would call these APIs from ChatView on user action after entity is prepared
-- TODO - APIs to call APIConnect
-- TODO - or new API for asynchronous connection? keep APIConnect for legacy links?
APIConnectPreparedContact contactId msgContent_ -> withUser $ \user -> do
-- TODO [short links] connect to prepared contact
-- TODO - for "invitation" contact:
-- TODO - optional message to be sent on successful "sender secure"?
-- TODO - call APIConnect, wait for synchronous (successful) response?
-- TODO - or persist message and queue it asynchronously?
-- TODO - rework agent to allow queueing messages for New connections?
-- TODO - for "address" contact:
-- TODO - optional message to be sent in contact request (pass to APIConnect)
-- Alternative to passing incognito to APIConnectPreparedContact, APIConnectPreparedGroup would be to
-- create new APIs to set incognito on entity - APISetContactIncognito, APISetGroupIncognito.
-- It would be more complex:
-- - would require to persist incognito profile on entity opposing to connection as currently,
-- - would require decomposing part of APIConnect.
-- As it's an edge case / not a big issue that it's not persisted like a change of user,
-- we're simply passing it to prepare here.
APIConnectPreparedContact contactId incognito msgContent_ -> withUser $ \user@User {userId} -> do
ct@Contact {connLinkToConnect} <- withFastStore $ \db -> getContact db vr user contactId
case connLinkToConnect of
Nothing -> throwCmdError "contact doesn't have link to connect"
Just link -> case link of
(ACCL SCMInvitation ccLink) ->
connectViaInvitation user incognito ccLink (Just contactId) >>= \case
CRSentConfirmation {} -> do
-- get updated contact with connection
ct' <- withFastStore $ \db -> getContact db vr user contactId
forM_ msgContent_ $ \mc -> do
let evt = XMsgNew $ MCSimple (extMsgContent mc Nothing)
(msg, _) <- sendDirectContactMessage user ct' evt
ci <- saveSndChatItem user (CDDirectSnd ct') msg (CISndMsgContent mc)
toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct') ci]
pure $ CRStartedConnectionToContact user ct'
cr -> pure cr
(ACCL SCMContact ccLink) ->
connectViaContact user incognito ccLink msgContent_ (Just $ CGMContactId contactId) >>= \case
CRSentInvitation {} -> do
-- get updated contact with connection
ct' <- withFastStore $ \db -> getContact db vr user contactId
forM_ msgContent_ $ \mc ->
createInternalChatItem user (CDDirectSnd ct') (CISndMsgContent mc) Nothing
pure $ CRStartedConnectionToContact user ct'
cr -> pure cr
-- TODO [short links] connect to prepared group
APIConnectPreparedGroup groupId incognito -> withUser $ \user -> do
ok_
APIConnectPreparedGroup groupId -> withUser $ \user -> do
ok_
APIConnect userId incognito (Just (ACCL SCMInvitation (CCLink cReq@(CRInvitationUri crData e2e) sLnk_))) mc_ -> withUserId userId $ \user -> withInvitationLock "connect" (strEncode cReq) . procCmd $ do
APIConnect userId incognito (Just (ACCL SCMInvitation ccLink)) mc_ -> withUserId userId $ \user -> do
when (isJust mc_) $ throwChatError CEConnReqMessageProhibited
subMode <- chatReadVar subscriptionMode
-- [incognito] generate profile to send
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = userProfileToSend user incognitoProfile Nothing False
lift (withAgent' $ \a -> connRequestPQSupport a PQSupportOn cReq) >>= \case
Nothing -> throwChatError CEInvalidConnReq
-- TODO PQ the error above should be CEIncompatibleConnReqVersion, also the same API should be called in Plan
Just (agentV, pqSup') -> do
let chatV = agentToChatVersion agentV
dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend
-- TODO [short links] use short link data on connection:
-- TODO - new connection (Nothing) is only for legacy links
-- TODO - existing contact is new normal (allow existing connection to have contact or change approach)
withFastStore' (\db -> getConnectionEntityByConnReq db vr user cReqs) >>= \case
Nothing -> joinNewConn chatV dm
Just (RcvDirectMsgConnection conn@Connection {connId, connStatus, contactConnInitiated} Nothing)
| connStatus == ConnNew && contactConnInitiated -> joinNewConn chatV dm -- own connection link
| connStatus == ConnPrepared -> do
-- retrying join after error
pcc <- withFastStore $ \db -> getPendingContactConnection db userId connId
joinPreparedConn (aConnId conn) pcc dm
Just ent -> throwCmdError $ "connection exists: " <> show (connEntityInfo ent)
where
joinNewConn chatV dm = do
connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup'
let ccLink = CCLink cReq $ serverShortLink <$> sLnk_
pcc <- withFastStore' $ \db -> createDirectConnection db user connId ccLink ConnPrepared (incognitoProfile $> profileToSend) subMode chatV pqSup'
joinPreparedConn connId pcc dm
joinPreparedConn connId pcc@PendingContactConnection {pccConnId} dm = do
void $ withAgent $ \a -> joinConnection a (aUserId user) connId True cReq dm pqSup' subMode
withFastStore' $ \db -> updateConnectionStatusFromTo db pccConnId ConnPrepared ConnJoined
pure $ CRSentConfirmation user pcc {pccConnStatus = ConnJoined}
cReqs =
( CRInvitationUri crData {crScheme = SSSimplex} e2e,
CRInvitationUri crData {crScheme = simplexChat} e2e
)
APIConnect userId incognito (Just (ACCL SCMContact ccLink)) mc_ -> withUserId userId $ \user -> connectViaContact user incognito ccLink mc_
connectViaInvitation user incognito ccLink Nothing
APIConnect userId incognito (Just (ACCL SCMContact ccLink)) mc_ -> withUserId userId $ \user ->
connectViaContact user incognito ccLink mc_ Nothing
APIConnect _ _ Nothing _ -> throwChatError CEInvalidConnReq
Connect incognito (Just cLink@(ACL m cLink')) -> withUser $ \user -> do
(ccLink, plan) <- connectPlan user cLink `catchChatError` \e -> case cLink' of CLFull cReq -> pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing)); _ -> throwError e
@@ -1828,7 +1826,34 @@ processChatCommand' vr = \case
processChatCommand $ APIListContacts userId
APICreateMyAddress userId short -> withUserId userId $ \user -> procCmd $ do
subMode <- chatReadVar subscriptionMode
let userData = shortLinkUserData short
-- TODO [short links] incognito interaction with contact address
-- TODO - problems:
-- TODO 1 now that user profile is advertised in short link, giving an option to
-- TODO share incognito profile on accept doesn't make sense.
-- TODO 2 even advertising a random incognito profile in short link is somewhat broken,
-- TODO as it would be the same for all connecting clients, but then changed on accept (in current implementation),
-- TODO so it would be clear it's incognito profile; it might as well be clearly a placeholder
-- TODO (e.g. "Hidden profile" in profile name), and to avoid distinguishing incognito and main profiles,
-- TODO it can be a setting that can be set for main profile too.
-- TODO 3 changing short link data from main to incognito profile also defeats the purpose of incognito profile,
-- TODO as by scanning the short link in the past, connecting clients may know main profile (even if it's
-- TODO currently set as incognito).
-- TODO - some possibilities:
-- TODO 1 always base choice on autoAccept -> acceptIncognito choice, don't give option on user accept action
-- TODO 2 in this case, replace short link user data on change of this setting? (doesn't solve problem 3)
-- TODO 3 give setting to include "Hidden profile" in short link, even if autoAccept is not set to incognito
-- TODO 4 share same random profile on each accept, this way connecting clients technically
-- TODO wouldn't be able to distinguish incognito profile (placeholder problem);
-- TODO 5 only give choice to accept with main or incognito profile if random profile or placeholder is shared
-- TODO in short link user data; if main profile is shared, don't give choice
-- TODO 6 don't allow to change from main profile in short link to "Hidden profile" (or incognito autoAccept),
-- TODO only allow to change vice versa, in one direction (solves problem 3)
-- TODO 7 remove incognito functionality from address altogether
-- TODO - it seems measures 3, 5, 6 are the most reasonable, or removing incognito functionality for addresses altogether
let userData =
if short
then Just $ encodeShortLinkData (ContactShortLinkData (userProfileToSend user Nothing Nothing False) Nothing)
else Nothing
(connId, ccLink) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact userData Nothing IKPQOn subMode
ccLink' <- shortenCreatedLink ccLink
withFastStore $ \db -> createUserContactLink db user connId ccLink' subMode
@@ -1853,11 +1878,14 @@ processChatCommand' vr = \case
ShowMyAddress -> withUser' $ \User {userId} ->
processChatCommand $ APIShowMyAddress userId
APIAddMyAddressShortLink userId -> withUserId' userId $ \user -> do
(ucl@UserContactLink {connLinkContact = CCLink connFullLink sLnk_}, conn) <-
(ucl@UserContactLink {connLinkContact = CCLink connFullLink sLnk_, autoAccept}, conn) <-
withFastStore $ \db -> (,) <$> getUserAddress db user <*> getUserAddressConnection db vr user
when (isJust sLnk_) $ throwCmdError "address already has short link"
-- TODO [short links] set ContactShortLinkData
sLnk <- shortenShortLink' =<< withAgent (\a -> setConnShortLink a (aConnId conn) SCMContact "" Nothing)
-- TODO [short links] allow to add short link without data if autoAccept was set to incognito?
let shortLinkProfile = userProfileToSend user Nothing Nothing False
shortLinkMsg = autoAccept >>= autoReply >>= (Just . msgContentText)
userData = encodeShortLinkData (ContactShortLinkData shortLinkProfile shortLinkMsg)
sLnk <- shortenShortLink' =<< withAgent (\a -> setConnShortLink a (aConnId conn) SCMContact userData Nothing)
case entityId conn of
Just uclId -> do
withFastStore' $ \db -> setUserContactLinkShortLink db uclId sLnk
@@ -1875,6 +1903,7 @@ processChatCommand' vr = \case
SetProfileAddress onOff -> withUser $ \User {userId} ->
processChatCommand $ APISetProfileAddress userId onOff
APIAddressAutoAccept userId autoAccept_ -> withUserId userId $ \user -> do
-- TODO [short links] update adress short link data if message changed
forM_ autoAccept_ $ \AutoAccept {businessAddress, acceptIncognito} ->
when (businessAddress && acceptIncognito) $ throwCmdError "requests to business address cannot be accepted incognito"
contactLink <- withFastStore (\db -> updateUserAddressAutoAccept db user autoAccept_)
@@ -2419,6 +2448,7 @@ processChatCommand' vr = \case
processChatCommand $ APIListGroups userId (contactId' <$> ct_) search_
APIUpdateGroupProfile groupId p' -> withUser $ \user -> do
g <- withFastStore $ \db -> getGroup db vr user groupId
-- TODO [short links] update group link short link data
runUpdateGroupProfile user g p'
UpdateGroupNames gName GroupProfile {displayName, fullName} ->
updateGroupProfileByName gName $ \p -> p {displayName, fullName}
@@ -2429,13 +2459,16 @@ processChatCommand' vr = \case
ShowGroupDescription gName -> withUser $ \user ->
CRGroupDescription user <$> withFastStore (\db -> getGroupInfoByName db vr user gName)
APICreateGroupLink groupId mRole short -> withUser $ \user -> withGroupLock "createGroupLink" groupId $ do
gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
gInfo@GroupInfo {groupProfile} <- withFastStore $ \db -> getGroupInfo db vr user groupId
assertUserGroupRole gInfo GRAdmin
when (mRole > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole
groupLinkId <- GroupLinkId <$> drgRandomBytes 16
subMode <- chatReadVar subscriptionMode
let crClientData = encodeJSON $ CRDataGroup groupLinkId
userData = shortLinkUserData short
let userData =
if short
then Just $ encodeShortLinkData (GroupShortLinkData groupProfile)
else Nothing
crClientData = encodeJSON $ CRDataGroup groupLinkId
(connId, ccLink) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact userData (Just crClientData) IKPQOff subMode
ccLink' <- createdGroupLink <$> shortenCreatedLink ccLink
withFastStore $ \db -> createGroupLink db user gInfo connId ccLink' groupLinkId mRole subMode
@@ -2462,9 +2495,10 @@ processChatCommand' vr = \case
conn <- getGroupLinkConnection db vr user gInfo
pure (gInfo, gLink, conn)
when (isJust sLnk_) $ throwCmdError "group link already has short link"
let crClientData = encodeJSON $ CRDataGroup gLinkId
-- TODO [short links] set GroupShortLinkData
sLnk <- shortenShortLink' =<< toShortGroupLink <$> withAgent (\a -> setConnShortLink a (aConnId conn) SCMContact "" (Just crClientData))
let GroupInfo {groupProfile} = gInfo
userData = encodeShortLinkData (GroupShortLinkData groupProfile)
crClientData = encodeJSON $ CRDataGroup gLinkId
sLnk <- shortenShortLink' . toShortGroupLink =<< withAgent (\a -> setConnShortLink a (aConnId conn) SCMContact userData (Just crClientData))
withFastStore' $ \db -> setUserContactLinkShortLink db uclId sLnk
let groupLink' = CCLink connFullLink (Just sLnk)
pure $ CRGroupLink user gInfo groupLink' mRole
@@ -2839,8 +2873,47 @@ processChatCommand' vr = \case
CTGroup -> withFastStore $ \db -> getGroupChatItemIdByText' db user cId msg
CTLocal -> withFastStore $ \db -> getLocalChatItemIdByText' db user cId msg
_ -> throwCmdError "not supported"
connectViaContact :: User -> IncognitoEnabled -> CreatedLinkContact -> Maybe MsgContent -> CM ChatResponse
connectViaContact user@User {userId} incognito (CCLink cReq@(CRContactUri ConnReqUriData {crClientData}) sLnk) mc_ = withInvitationLock "connectViaContact" (strEncode cReq) $ do
connectViaInvitation :: User -> IncognitoEnabled -> CreatedLinkInvitation -> Maybe ContactId -> CM ChatResponse
connectViaInvitation user@User {userId} incognito (CCLink cReq@(CRInvitationUri crData e2e) sLnk_) contactId_ =
withInvitationLock "connect" (strEncode cReq) . procCmd $ do
subMode <- chatReadVar subscriptionMode
-- [incognito] generate profile to send
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = userProfileToSend user incognitoProfile Nothing False
lift (withAgent' $ \a -> connRequestPQSupport a PQSupportOn cReq) >>= \case
Nothing -> throwChatError CEInvalidConnReq
-- TODO PQ the error above should be CEIncompatibleConnReqVersion, also the same API should be called in Plan
Just (agentV, pqSup') -> do
let chatV = agentToChatVersion agentV
dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend
withFastStore' (\db -> getConnectionEntityByConnReq db vr user cReqs) >>= \case
Nothing -> joinNewConn chatV dm
Just (RcvDirectMsgConnection conn@Connection {connId, connStatus, contactConnInitiated} _ct_)
| connStatus == ConnNew && contactConnInitiated -> joinNewConn chatV dm -- own connection link
| connStatus == ConnPrepared -> do
-- retrying join after error
pcc <- withFastStore $ \db -> getPendingContactConnection db userId connId
joinPreparedConn (aConnId conn) pcc dm
Just ent -> throwCmdError $ "connection is not RcvDirectMsgConnection: " <> show (connEntityInfo ent)
where
joinNewConn chatV dm = do
connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup'
let ccLink = CCLink cReq $ serverShortLink <$> sLnk_
pcc <- withFastStore' $ \db -> createDirectConnection db user connId ccLink contactId_ ConnPrepared (incognitoProfile $> profileToSend) subMode chatV pqSup'
joinPreparedConn connId pcc dm
joinPreparedConn connId pcc@PendingContactConnection {pccConnId} dm = do
sqSecured <- withAgent $ \a -> joinConnection a (aUserId user) connId True cReq dm pqSup' subMode
let newStatus = if sqSecured then ConnSndReady else ConnJoined
withFastStore' $ \db -> updateConnectionStatusFromTo db pccConnId ConnPrepared newStatus
pure $ CRSentConfirmation user pcc {pccConnStatus = newStatus}
cReqs =
( CRInvitationUri crData {crScheme = SSSimplex} e2e,
CRInvitationUri crData {crScheme = simplexChat} e2e
)
-- TODO [short links] Maybe Int64 should be Maybe <entity id type> to differentiate between contact and group links;
-- TODO link connection to entity in createConnReqConnection
connectViaContact :: User -> IncognitoEnabled -> CreatedLinkContact -> Maybe MsgContent -> Maybe ContactOrGroupMemberId -> CM ChatResponse
connectViaContact user@User {userId} incognito (CCLink cReq@(CRContactUri ConnReqUriData {crClientData}) sLnk) mc_ comId_ = withInvitationLock "connectViaContact" (strEncode cReq) $ do
let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
case groupLinkId of
@@ -2872,7 +2945,7 @@ processChatCommand' vr = \case
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
subMode <- chatReadVar subscriptionMode
let sLnk' = serverShortLink <$> sLnk
conn@PendingContactConnection {pccConnId} <- withFastStore' $ \db -> createConnReqConnection db userId connId cReqHash sLnk' xContactId incognitoProfile groupLinkId subMode chatV pqSup
conn@PendingContactConnection {pccConnId} <- withFastStore' $ \db -> createConnReqConnection db userId connId cReqHash sLnk' comId_ xContactId incognitoProfile groupLinkId subMode chatV pqSup
joinContact user pccConnId connId cReq incognitoProfile xContactId mc_ inGroup pqSup chatV
pure $ CRSentInvitation user conn incognitoProfile
connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> CreatedLinkContact -> CM ChatResponse
@@ -3211,11 +3284,12 @@ processChatCommand' vr = \case
CLShort l -> do
let l' = serverShortLink l
withFastStore' (\db -> getConnectionEntityViaShortLink db vr user l') >>= \case
Just (cReq, ent) ->
(ACCL SCMInvitation (CCLink cReq (Just l')),) <$> (invitationEntityPlan ent `catchChatError` (pure . CPError))
Just (cReq, ent) -> do
plan <- invitationEntityPlan Nothing ent `catchChatError` (pure . CPError)
pure (ACCL SCMInvitation (CCLink cReq (Just l')), plan)
Nothing -> do
(cReq, cData) <- getShortLinkConnReq user l'
let contactSLinkData_ = decodeJSON . safeDecodeUtf8 $ linkUserData cData
let contactSLinkData_ = decodeShortLinkData $ linkUserData cData
invitationReqAndPlan cReq (Just l') contactSLinkData_
where
invitationReqAndPlan cReq sLnk_ contactSLinkData_ = do
@@ -3233,7 +3307,7 @@ processChatCommand' vr = \case
Just (UserContactLink (CCLink cReq _) _) -> pure (ACCL SCMContact $ CCLink cReq (Just l'), CPContactAddress CAPOwnLink)
Nothing -> do
(cReq, cData) <- getShortLinkConnReq user l'
let contactSLinkData_ = decodeJSON . safeDecodeUtf8 $ linkUserData cData
let contactSLinkData_ = decodeShortLinkData $ linkUserData cData
plan <- contactRequestPlan user cReq contactSLinkData_
pure (ACCL SCMContact $ CCLink cReq (Just l'), plan)
CCTGroup ->
@@ -3241,7 +3315,7 @@ processChatCommand' vr = \case
Just (cReq, g) -> pure (ACCL SCMContact $ CCLink cReq (Just l'), CPGroupLink (GLPOwnLink g))
Nothing -> do
(cReq, cData) <- getShortLinkConnReq user l'
let groupSLinkData_ = decodeJSON . safeDecodeUtf8 $ linkUserData cData
let groupSLinkData_ = decodeShortLinkData $ linkUserData cData
plan <- groupJoinRequestPlan user cReq groupSLinkData_
pure (ACCL SCMContact $ CCLink cReq (Just l'), plan)
CCTChannel -> throwCmdError "channel links are not supported in this version"
@@ -3258,29 +3332,23 @@ processChatCommand' vr = \case
invitationRequestPlan user cReq contactSLinkData_ = do
withFastStore' (\db -> getConnectionEntityByConnReq db vr user $ invCReqSchemas cReq) >>= \case
Nothing -> pure $ CPInvitationLink (ILPOk contactSLinkData_)
Just ent -> invitationEntityPlan ent
Just ent -> invitationEntityPlan contactSLinkData_ ent
where
invCReqSchemas :: ConnReqInvitation -> (ConnReqInvitation, ConnReqInvitation)
invCReqSchemas (CRInvitationUri crData e2e) =
( CRInvitationUri crData {crScheme = SSSimplex} e2e,
CRInvitationUri crData {crScheme = simplexChat} e2e
)
invitationEntityPlan :: ConnectionEntity -> CM ConnectionPlan
invitationEntityPlan = \case
RcvDirectMsgConnection Connection {connStatus = ConnPrepared} Nothing ->
-- TODO [short links] entity is already found - passing ContactShortLinkData doesn't make sense?
pure $ CPInvitationLink (ILPOk Nothing)
RcvDirectMsgConnection conn ct_ -> do
let Connection {connStatus, contactConnInitiated} = conn
if
| connStatus == ConnNew && contactConnInitiated ->
pure $ CPInvitationLink ILPOwnLink
-- TODO [short links] check status (now present contact may mean scanned, not only connecting)
| 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"
invitationEntityPlan :: Maybe ContactShortLinkData -> ConnectionEntity -> CM ConnectionPlan
invitationEntityPlan contactSLinkData_ = \case
RcvDirectMsgConnection Connection {connStatus, contactConnInitiated} ct_ -> case ct_ of
Just ct
| contactActive ct -> pure $ CPInvitationLink (ILPKnown ct)
| otherwise -> pure $ CPInvitationLink (ILPOk contactSLinkData_)
Nothing
| connStatus == ConnNew && contactConnInitiated -> pure $ CPInvitationLink ILPOwnLink
| connStatus == ConnPrepared -> pure $ CPInvitationLink (ILPOk contactSLinkData_)
| otherwise -> pure $ CPInvitationLink (ILPConnecting Nothing)
_ -> throwCmdError "found connection entity is not RcvDirectMsgConnection"
contactOrGroupRequestPlan :: User -> ConnReqContact -> CM ConnectionPlan
contactOrGroupRequestPlan user cReq@(CRContactUri crData) = do
@@ -3357,8 +3425,19 @@ processChatCommand' vr = \case
CSLInvitation _ srv lnkId linkKey -> CSLInvitation SLSServer srv lnkId linkKey
CSLContact _ ct srv linkKey -> CSLContact SLSServer ct srv linkKey
restoreShortLink' l = (`restoreShortLink` l) <$> asks (shortLinkPresetServers . config)
-- TODO [short links] pass encoded ContactShortLinkData or GroupShortLinkData
shortLinkUserData short = if short then Just "" else Nothing
encodeShortLinkData :: J.ToJSON a => a -> ByteString
encodeShortLinkData = encodeUtf8 . encodeJSON
decodeShortLinkData :: J.FromJSON a => ByteString -> Maybe a
decodeShortLinkData = decodeJSON . safeDecodeUtf8
updatePCCShortLinkData :: J.ToJSON a => PendingContactConnection -> a -> CM (Maybe ShortLinkInvitation)
updatePCCShortLinkData conn@PendingContactConnection {connLinkInv} shortLinkData = do
let short = isJust $ connShortLink =<< connLinkInv
if short
then do
let userData = encodeShortLinkData shortLinkData
sLnk <- shortenShortLink' =<< withAgent (\a -> setConnShortLink a (aConnId' conn) SCMInvitation userData Nothing)
pure $ Just sLnk
else pure Nothing
shortenShortLink' :: ConnShortLink m -> CM (ConnShortLink m)
shortenShortLink' l = (`shortenShortLink` l) <$> asks (shortLinkPresetServers . config)
shortenCreatedLink :: CreatedConnLink m -> CM (CreatedConnLink m)
@@ -4321,12 +4400,12 @@ chatCommandP =
"/_contacts " *> (APIListContacts <$> A.decimal),
"/contacts" $> ListContacts,
"/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> strP),
"/_prepare contact" *> (APIPrepareContact <$> A.decimal <* A.space <*> jsonP <* A.space <*> connLinkP),
"/_prepare group" *> (APIPrepareGroup <$> A.decimal <* A.space <*> jsonP <* A.space <*> connLinkP),
"/_prepare contact " *> (APIPrepareContact <$> A.decimal <* A.space <*> connLinkP <* A.space <*> jsonP),
"/_prepare group " *> (APIPrepareGroup <$> A.decimal <* A.space <*> connLinkP <* A.space <*> jsonP),
"/_set contact user @" *> (APIChangeContactUser <$> A.decimal <* A.space <*> A.decimal),
"/_set group user #" *> (APIChangeGroupUser <$> A.decimal <* A.space <*> A.decimal),
"/_connect contact @" *> (APIConnectPreparedContact <$> A.decimal <*> optional (A.space *> msgContentP)),
"/_connect group $" *> (APIConnectPreparedGroup <$> A.decimal),
"/_connect contact @" *> (APIConnectPreparedContact <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> msgContentP)),
"/_connect group #" *> (APIConnectPreparedGroup <$> A.decimal <*> incognitoOnOffP),
"/_connect " *> (APIAddContact <$> A.decimal <*> shortOnOffP <*> incognitoOnOffP),
"/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> connLinkP_ <*> optional (A.space *> msgContentP)),
"/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP),

2
src/Simplex/Chat/Library/Subscriber.hs
View File

@@ -667,6 +667,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- TODO add debugging output
_ -> pure ()
where
-- TODO [short links] don't send auto-reply message if it should have been created by connecting client
-- TODO (based on version + whether address has short link data)
sendAutoReply ct = \case
Just AutoAccept {autoReply = Just mc} -> do
(msg, _) <- sendDirectContactMessage user ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))

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

@@ -112,7 +112,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
[sql|
SELECT
c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_req_to_connect,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect,
c.contact_group_member_id, c.contact_grp_inv_sent, c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl
FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
@@ -120,12 +120,13 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|]
(userId, contactId)
toContact' :: Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (connReqToConnect, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) =
toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (connFullLink, connShortLink, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
activeConn = Just conn
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, connReqToConnect, contactGroupMemberId, contactGrpInvSent, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
connLinkToConnect = toACreatedConnLink_ connFullLink connShortLink
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, connLinkToConnect, contactGroupMemberId, contactGrpInvSent, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ groupMemberId c = do
gm <-
@@ -138,7 +139,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_req_to_connect,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupInfo {membership}

107
src/Simplex/Chat/Store/Direct.hs
View File

@@ -30,6 +30,7 @@ module Simplex.Chat.Store.Direct
getProfileById,
getConnReqContactXContactId,
getContactByConnReqHash,
createPreparedContact,
createDirectContact,
deleteContactConnections,
deleteContactFiles,
@@ -100,7 +101,7 @@ import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (ConnId, CreatedConnLink (..), InvitationId, UserId)
import Simplex.Messaging.Agent.Protocol (ACreatedConnLink, ConnId, CreatedConnLink (..), InvitationId, UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -150,12 +151,11 @@ deletePendingContactConnection db userId connId =
createAddressContactConnection :: DB.Connection -> VersionRangeChat -> User -> Contact -> ConnId -> ConnReqUriHash -> Maybe ShortLinkContact -> XContactId -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> ExceptT StoreError IO (Int64, Contact)
createAddressContactConnection db vr user@User {userId} Contact {contactId} acId cReqHash sLnk xContactId incognitoProfile subMode chatV pqSup = do
PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash sLnk xContactId incognitoProfile Nothing subMode chatV pqSup
liftIO $ DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, pccConnId)
PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash sLnk (Just $ CGMContactId contactId) xContactId incognitoProfile Nothing subMode chatV pqSup
(pccConnId,) <$> getContact db vr user contactId
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> Maybe ShortLinkContact -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
createConnReqConnection db userId acId cReqHash sLnk xContactId incognitoProfile groupLinkId subMode chatV pqSup = do
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> Maybe ShortLinkContact -> Maybe ContactOrGroupMemberId -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
createConnReqConnection db userId acId cReqHash sLnk comId_ xContactId incognitoProfile groupLinkId subMode chatV pqSup = do
createdAt <- getCurrentTime
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
let pccConnStatus = ConnJoined
@@ -164,16 +164,23 @@ createConnReqConnection db userId acId cReqHash sLnk xContactId incognitoProfile
[sql|
INSERT INTO connections (
user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated,
via_contact_uri_hash, via_short_link_contact, xcontact_id, custom_user_profile_id, via_group_link, group_link_id,
via_contact_uri_hash, via_short_link_contact, contact_id, group_member_id,
xcontact_id, custom_user_profile_id, via_group_link, group_link_id,
created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, pccConnStatus, ConnContact, BI True, cReqHash, sLnk, xContactId)
:. (customUserProfileId, BI (isJust groupLinkId), groupLinkId)
( (userId, acId, pccConnStatus, ConnContact, BI True)
:. (cReqHash, sLnk, contactId_, groupMemberId_)
:. (xContactId, customUserProfileId, BI (isJust groupLinkId), groupLinkId)
:. (createdAt, createdAt, BI (subMode == SMOnlyCreate), chatV, pqSup, pqSup)
)
pccConnId <- insertedRowId db
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connLinkInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt}
where
(contactId_, groupMemberId_) = case comId_ of
Just (CGMContactId ctId) -> (Just ctId, Nothing)
Just (CGMGroupMemberId gmId) -> (Nothing, Just gmId)
Nothing -> (Nothing, Nothing)
getConnReqContactXContactId :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId)
getConnReqContactXContactId db vr user@User {userId} cReqHash = do
@@ -199,7 +206,7 @@ getContactByConnReqHash db vr user@User {userId} cReqHash = do
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.conn_req_to_connect,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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,
@@ -215,8 +222,8 @@ getContactByConnReqHash db vr user@User {userId} cReqHash = do
(userId, cReqHash, CSActive)
mapM (addDirectChatTags db) ct_
createDirectConnection :: DB.Connection -> User -> ConnId -> CreatedLinkInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
createDirectConnection db User {userId} acId ccLink@(CCLink cReq shortLinkInv) pccConnStatus incognitoProfile subMode chatV pqSup = do
createDirectConnection :: DB.Connection -> User -> ConnId -> CreatedLinkInvitation -> Maybe ContactId -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
createDirectConnection db User {userId} acId ccLink@(CCLink cReq shortLinkInv) contactId_ pccConnStatus incognitoProfile subMode chatV pqSup = do
createdAt <- getCurrentTime
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
let contactConnInitiated = pccConnStatus == ConnNew
@@ -224,11 +231,11 @@ createDirectConnection db User {userId} acId ccLink@(CCLink cReq shortLinkInv) p
db
[sql|
INSERT INTO connections
(user_id, agent_conn_id, conn_req_inv, short_link_inv, conn_status, conn_type, contact_conn_initiated, custom_user_profile_id,
(user_id, agent_conn_id, conn_req_inv, short_link_inv, conn_status, conn_type, contact_id, contact_conn_initiated, custom_user_profile_id,
created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, cReq, shortLinkInv, pccConnStatus, ConnContact, BI contactConnInitiated, customUserProfileId)
( (userId, acId, cReq, shortLinkInv, pccConnStatus, ConnContact, contactId_, BI contactConnInitiated, customUserProfileId)
:. (createdAt, createdAt, BI (subMode == SMOnlyCreate), chatV, pqSup, pqSup)
)
pccConnId <- insertedRowId db
@@ -239,10 +246,42 @@ createIncognitoProfile db User {userId} p = do
createdAt <- getCurrentTime
createIncognitoProfile_ db userId createdAt p
createPreparedContact :: DB.Connection -> User -> Profile -> ACreatedConnLink -> ExceptT StoreError IO Contact
createPreparedContact db user@User {userId} p@Profile {preferences} connLinkToConnect = do
currentTs <- liftIO getCurrentTime
(localDisplayName, contactId, profileId) <- createContact_ db userId p (Just connLinkToConnect) "" Nothing currentTs
let profile = toLocalProfile profileId p ""
userPreferences = emptyChatPrefs
mergedPreferences = contactUserPreferences user userPreferences preferences False
pure $
Contact
{ contactId,
localDisplayName,
profile,
activeConn = Nothing,
viaGroup = Nothing,
contactUsed = True,
contactStatus = CSActive,
chatSettings = defaultChatSettings,
userPreferences,
mergedPreferences,
createdAt = currentTs,
updatedAt = currentTs,
chatTs = Just currentTs,
connLinkToConnect = Just connLinkToConnect,
contactGroupMemberId = Nothing,
contactGrpInvSent = False,
chatTags = [],
chatItemTTL = Nothing,
uiThemes = Nothing,
chatDeleted = False,
customData = Nothing
}
createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} = do
currentTs <- liftIO getCurrentTime
(localDisplayName, contactId, profileId) <- createContact_ db userId p localAlias Nothing currentTs
(localDisplayName, contactId, profileId) <- createContact_ db userId p Nothing localAlias Nothing 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
@@ -262,7 +301,7 @@ createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p
createdAt = currentTs,
updatedAt = currentTs,
chatTs = Just currentTs,
connReqToConnect = Nothing,
connLinkToConnect = Nothing,
contactGroupMemberId = Nothing,
contactGrpInvSent = False,
chatTags = [],
@@ -429,31 +468,39 @@ updateContactConnectionAlias db userId conn localAlias = do
(localAlias, updatedAt, userId, pccConnId conn)
pure (conn :: PendingContactConnection) {localAlias, updatedAt}
updatePCCIncognito :: DB.Connection -> User -> PendingContactConnection -> Maybe ProfileId -> IO PendingContactConnection
updatePCCIncognito db User {userId} conn customUserProfileId = do
updatePCCIncognito :: DB.Connection -> User -> PendingContactConnection -> Maybe ProfileId -> Maybe ShortLinkInvitation -> IO PendingContactConnection
updatePCCIncognito db User {userId} conn@PendingContactConnection {connLinkInv} customUserProfileId sLnk = do
updatedAt <- getCurrentTime
DB.execute
db
[sql|
UPDATE connections
SET custom_user_profile_id = ?, updated_at = ?
SET custom_user_profile_id = ?, short_link_inv = ?, updated_at = ?
WHERE user_id = ? AND connection_id = ?
|]
(customUserProfileId, updatedAt, userId, pccConnId conn)
pure (conn :: PendingContactConnection) {customUserProfileId, updatedAt}
(customUserProfileId, sLnk, updatedAt, userId, pccConnId conn)
pure (conn :: PendingContactConnection) {customUserProfileId, connLinkInv = connLinkInv', updatedAt}
where
connLinkInv' = case connLinkInv of
Just (CCLink cReq _) -> Just (CCLink cReq sLnk)
Nothing -> Nothing
updatePCCUser :: DB.Connection -> UserId -> PendingContactConnection -> UserId -> IO PendingContactConnection
updatePCCUser db userId conn newUserId = do
updatePCCUser :: DB.Connection -> UserId -> PendingContactConnection -> UserId -> Maybe ShortLinkInvitation -> IO PendingContactConnection
updatePCCUser db userId conn@PendingContactConnection {connLinkInv} newUserId sLnk = do
updatedAt <- getCurrentTime
DB.execute
db
[sql|
UPDATE connections
SET user_id = ?, custom_user_profile_id = NULL, updated_at = ?
SET user_id = ?, short_link_inv = ?, custom_user_profile_id = NULL, updated_at = ?
WHERE user_id = ? AND connection_id = ?
|]
(newUserId, updatedAt, userId, pccConnId conn)
pure (conn :: PendingContactConnection) {customUserProfileId = Nothing, updatedAt}
(newUserId, sLnk, updatedAt, userId, pccConnId conn)
pure (conn :: PendingContactConnection) {customUserProfileId = Nothing, connLinkInv = connLinkInv', updatedAt}
where
connLinkInv' = case connLinkInv of
Just (CCLink cReq _) -> Just (CCLink cReq sLnk)
Nothing -> Nothing
deletePCCIncognitoProfile :: DB.Connection -> User -> ProfileId -> IO ()
deletePCCIncognitoProfile db User {userId} profileId =
@@ -652,7 +699,7 @@ createOrUpdateContactRequest db vr user@User {userId, userContactId} userContact
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.conn_req_to_connect,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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,
@@ -829,7 +876,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
createdAt,
updatedAt = createdAt,
chatTs = Just createdAt,
connReqToConnect = Nothing,
connLinkToConnect = Nothing,
contactGroupMemberId = Nothing,
contactGrpInvSent = False,
chatTags = [],
@@ -869,7 +916,7 @@ getContact_ db vr user@User {userId} contactId deleted = do
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.conn_req_to_connect,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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,

78
src/Simplex/Chat/Store/Groups.hs
View File

@@ -32,6 +32,7 @@ module Simplex.Chat.Store.Groups
createNewGroup,
createGroupInvitation,
deleteContactCardKeepConn,
createPreparedGroup,
createGroupInvitedViaLink,
createGroupRejectedViaLink,
setViaGroupLinkHash,
@@ -163,7 +164,7 @@ import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (ConnId, CreatedConnLink (..), UserId)
import Simplex.Messaging.Agent.Protocol (ACreatedConnLink, ConnId, CreatedConnLink (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, fromOnlyBI, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -283,7 +284,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr = do
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_req_to_connect,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupInfo {membership}
@@ -365,7 +366,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
updatedAt = currentTs,
chatTs = Just currentTs,
userMemberProfileSentAt = Just currentTs,
connReqToConnect = Nothing,
connLinkToConnect = Nothing,
chatTags = [],
chatItemTTL = Nothing,
uiThemes = Nothing,
@@ -437,7 +438,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
updatedAt = currentTs,
chatTs = Just currentTs,
userMemberProfileSentAt = Just currentTs,
connReqToConnect = Nothing,
connLinkToConnect = Nothing,
chatTags = [],
chatItemTTL = Nothing,
uiThemes = Nothing,
@@ -535,6 +536,24 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile {
DB.execute db "DELETE FROM contacts WHERE contact_id = ?" (Only contactId)
DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId)
createPreparedGroup :: DB.Connection -> VersionRangeChat -> User -> GroupProfile -> ACreatedConnLink -> ExceptT StoreError IO GroupInfo
createPreparedGroup db vr user@User {userId} groupProfile connLinkToConnect = do
currentTs <- liftIO getCurrentTime
-- TODO [short links] support preparing business chats
let business = Nothing
groupId <- createGroup_ db userId groupProfile (Just connLinkToConnect) business currentTs
-- TODO [short links] create "unknown" host member here? set invitedByGroupMemberId later?
-- TODO - same for invitedMember
-- TODO - for membershipStatus - new status GSMemNew?
-- TODO - customUserProfileId - pass on APIConnectPreparedGroup, update member; or separate apis for switching before joining?
let invitedByGroupMemberId = Nothing
invitedMember = MemberIdRole (MemberId "unknown") GRMember
membershipStatus = GSMemAccepted
customUserProfileId = Nothing
void $ createContactMemberInv_ db user groupId invitedByGroupMemberId user invitedMember GCUserMember membershipStatus IBUnknown customUserProfileId currentTs vr
-- TODO [short links] review: setViaGroupLinkHash
getGroupInfo db vr user groupId
createGroupInvitedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupInvitedViaLink db vr user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do
let fromMemberProfile = profileFromName fromMemberName
@@ -559,7 +578,7 @@ createGroupViaLink'
business
membershipStatus = do
currentTs <- liftIO getCurrentTime
groupId <- insertGroup_ currentTs
groupId <- createGroup_ db userId groupProfile Nothing business currentTs
hostMemberId <- insertHost_ currentTs groupId
liftIO $ DB.execute db "UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnMember, hostMemberId, currentTs, connId)
-- using IBUnknown since host is created without contact
@@ -567,25 +586,6 @@ createGroupViaLink'
liftIO $ setViaGroupLinkHash db groupId connId
(,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db vr user hostMemberId
where
insertGroup_ currentTs = ExceptT $ do
let GroupProfile {displayName, fullName, description, image, groupPreferences, memberAdmission} = groupProfile
withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
liftIO $ do
DB.execute
db
"INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, member_admission, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(displayName, fullName, description, image, userId, groupPreferences, memberAdmission, currentTs, currentTs)
profileId <- insertedRowId db
DB.execute
db
[sql|
INSERT INTO groups
(group_profile_id, local_display_name, user_id, enable_ntfs,
created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_member_id, customer_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?,?)
|]
((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
insertedRowId db
insertHost_ currentTs groupId = do
(localDisplayName, profileId) <- createNewMemberProfile_ db user fromMemberProfile currentTs
let MemberIdRole {memberId, memberRole} = fromMember
@@ -603,6 +603,28 @@ createGroupViaLink'
)
insertedRowId db
createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe ACreatedConnLink -> Maybe BusinessChatInfo -> UTCTime -> ExceptT StoreError IO GroupId
createGroup_ db userId groupProfile connLinkToConnect business currentTs = ExceptT $ do
let GroupProfile {displayName, fullName, description, image, groupPreferences, memberAdmission} = groupProfile
withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
liftIO $ do
DB.execute
db
"INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, member_admission, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(displayName, fullName, description, image, userId, groupPreferences, memberAdmission, currentTs, currentTs)
profileId <- insertedRowId db
DB.execute
db
[sql|
INSERT INTO groups
(group_profile_id, local_display_name, user_id, enable_ntfs,
created_at, updated_at, chat_ts, user_member_profile_sent_at, conn_full_link_to_connect, conn_short_link_to_connect,
business_chat, business_member_id, customer_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. connLinkToConnectRow connLinkToConnect :. businessChatInfoRow business)
insertedRowId db
setViaGroupLinkHash :: DB.Connection -> GroupId -> Int64 -> IO ()
setViaGroupLinkHash db groupId connId =
DB.execute
@@ -778,7 +800,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do
SELECT
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_req_to_connect,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
@@ -1638,7 +1660,7 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = do
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_req_to_connect,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupInfo {membership}
@@ -2314,7 +2336,7 @@ createMemberContact
quotaErrCounter = 0
}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, connReqToConnect = Nothing, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, connLinkToConnect = Nothing, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact db vr user contactId = do
@@ -2351,7 +2373,7 @@ createMemberContactInvited
contactId <- createContactUpdateMember currentTs userPreferences
ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, connReqToConnect = Nothing, contactGroupMemberId = Nothing, contactGrpInvSent = False, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, connLinkToConnect = Nothing, contactGroupMemberId = Nothing, contactGrpInvSent = False, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
m' = m {memberContactId = Just contactId}
pure (mCt', m')
where

12
src/Simplex/Chat/Store/SQLite/Migrations/M20250526_short_links.hs
View File

@@ -11,13 +11,17 @@ import Database.SQLite.Simple.QQ (sql)
m20250526_short_links :: Query
m20250526_short_links =
[sql|
ALTER TABLE contacts ADD COLUMN conn_req_to_connect BLOB;
ALTER TABLE groups ADD COLUMN conn_req_to_connect BLOB;
ALTER TABLE contacts ADD COLUMN conn_full_link_to_connect BLOB;
ALTER TABLE contacts ADD COLUMN conn_short_link_to_connect BLOB;
ALTER TABLE groups ADD COLUMN conn_full_link_to_connect BLOB;
ALTER TABLE groups ADD COLUMN conn_short_link_to_connect BLOB;
|]
down_m20250526_short_links :: Query
down_m20250526_short_links =
[sql|
ALTER TABLE contacts DROP COLUMN conn_req_to_connect;
ALTER TABLE groups DROP COLUMN conn_req_to_connect;
ALTER TABLE contacts DROP COLUMN conn_full_link_to_connect;
ALTER TABLE contacts DROP COLUMN conn_short_link_to_connect;
ALTER TABLE groups DROP COLUMN conn_full_link_to_connect;
ALTER TABLE groups DROP COLUMN conn_short_link_to_connect;
|]

54
src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
View File

@@ -33,14 +33,6 @@ Query:
Plan:
Query:
INSERT INTO groups
(group_profile_id, local_display_name, user_id, enable_ntfs,
created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_member_id, customer_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?,?)
Plan:
Query:
INSERT INTO groups
(group_profile_id, local_display_name, user_id, enable_ntfs,
@@ -54,7 +46,7 @@ Query:
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_req_to_connect,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupInfo {membership}
@@ -180,7 +172,7 @@ Query:
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.conn_req_to_connect,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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,
@@ -331,7 +323,7 @@ Plan:
Query:
SELECT
c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_req_to_connect,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect,
c.contact_group_member_id, c.contact_grp_inv_sent, c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl
FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
@@ -701,6 +693,15 @@ Query:
Plan:
Query:
INSERT INTO groups
(group_profile_id, local_display_name, user_id, enable_ntfs,
created_at, updated_at, chat_ts, user_member_profile_sent_at, conn_full_link_to_connect, conn_short_link_to_connect,
business_chat, business_member_id, customer_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
Query:
INSERT INTO groups
(local_display_name, user_id, group_profile_id, enable_ntfs,
@@ -828,7 +829,7 @@ Query:
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.conn_req_to_connect,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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,
@@ -852,7 +853,7 @@ Query:
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_req_to_connect,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupInfo {membership}
@@ -901,7 +902,7 @@ Query:
SELECT
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_req_to_connect,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
@@ -1398,7 +1399,7 @@ Query:
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.conn_req_to_connect,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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,
@@ -4034,9 +4035,9 @@ Plan:
Query:
INSERT INTO connections
(user_id, agent_conn_id, conn_req_inv, short_link_inv, conn_status, conn_type, contact_conn_initiated, custom_user_profile_id,
(user_id, agent_conn_id, conn_req_inv, short_link_inv, conn_status, conn_type, contact_id, contact_conn_initiated, custom_user_profile_id,
created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
@@ -4052,9 +4053,10 @@ Plan:
Query:
INSERT INTO connections (
user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated,
via_contact_uri_hash, via_short_link_contact, xcontact_id, custom_user_profile_id, via_group_link, group_link_id,
via_contact_uri_hash, via_short_link_contact, contact_id, group_member_id,
xcontact_id, custom_user_profile_id, via_group_link, group_link_id,
created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
@@ -4259,7 +4261,7 @@ SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE connections
SET custom_user_profile_id = ?, updated_at = ?
SET custom_user_profile_id = ?, short_link_inv = ?, updated_at = ?
WHERE user_id = ? AND connection_id = ?
Plan:
@@ -4307,7 +4309,7 @@ SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE connections
SET user_id = ?, custom_user_profile_id = NULL, updated_at = ?
SET user_id = ?, short_link_inv = ?, custom_user_profile_id = NULL, updated_at = ?
WHERE user_id = ? AND connection_id = ?
Plan:
@@ -4578,7 +4580,7 @@ Query:
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_req_to_connect,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupMember - membership
@@ -4603,7 +4605,7 @@ Query:
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_req_to_connect,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupMember - membership
@@ -5500,7 +5502,7 @@ Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, is
Plan:
SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used) VALUES (?,?,?,?,?,?,?,?)
Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect) VALUES (?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
@@ -5863,10 +5865,6 @@ Query: UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ?
Plan:
SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE connections SET contact_id = ? WHERE connection_id = ?
Plan:
SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?
Plan:
SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)

6
src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql
View File

@@ -79,7 +79,8 @@ CREATE TABLE contacts(
ui_themes TEXT,
chat_deleted INTEGER NOT NULL DEFAULT 0,
chat_item_ttl INTEGER,
conn_req_to_connect BLOB,
conn_full_link_to_connect BLOB,
conn_short_link_to_connect BLOB,
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
@@ -137,7 +138,8 @@ CREATE TABLE groups(
chat_item_ttl INTEGER,
local_alias TEXT DEFAULT '',
members_require_attention INTEGER NOT NULL DEFAULT 0,
conn_req_to_connect BLOB, -- received
conn_full_link_to_connect BLOB,
conn_short_link_to_connect BLOB, -- received
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE

47
src/Simplex/Chat/Store/Shared.hs
View File

@@ -2,6 +2,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -36,7 +37,7 @@ import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri, ConnId, ConnShortLink, ConnectionMode (..), CreatedConnLink (..), UserId)
import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), AConnShortLink (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionMode (..), CreatedConnLink (..), SConnectionMode (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -382,10 +383,10 @@ setCommandConnId db User {userId} cmdId connId = do
createContact :: DB.Connection -> User -> Profile -> ExceptT StoreError IO ()
createContact db User {userId} profile = do
currentTs <- liftIO getCurrentTime
void $ createContact_ db userId profile "" Nothing currentTs
void $ createContact_ db userId profile Nothing "" Nothing currentTs
createContact_ :: DB.Connection -> UserId -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
createContact_ db userId Profile {displayName, fullName, image, contactLink, preferences} localAlias viaGroup currentTs =
createContact_ :: DB.Connection -> UserId -> Profile -> Maybe ACreatedConnLink -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
createContact_ db userId Profile {displayName, fullName, image, contactLink, preferences} connLinkToConnect localAlias viaGroup currentTs =
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
DB.execute
db
@@ -394,11 +395,18 @@ createContact_ db userId Profile {displayName, fullName, image, contactLink, pre
profileId <- insertedRowId db
DB.execute
db
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used) VALUES (?,?,?,?,?,?,?,?)"
(profileId, ldn, userId, viaGroup, currentTs, currentTs, currentTs, BI True)
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect) VALUES (?,?,?,?,?,?,?,?,?,?)"
((profileId, ldn, userId, viaGroup, currentTs, currentTs, currentTs, BI True) :. connLinkToConnectRow connLinkToConnect)
contactId <- insertedRowId db
pure $ Right (ldn, contactId, profileId)
type ConnLinkToConnectRow = (Maybe AConnectionRequestUri, Maybe AConnShortLink)
connLinkToConnectRow :: Maybe ACreatedConnLink -> ConnLinkToConnectRow
connLinkToConnectRow = \case
Just (ACCL m (CCLink fullLink shortLink)) -> (Just (ACR m fullLink), ACSL m <$> shortLink)
Nothing -> (Nothing, Nothing)
deleteUnusedIncognitoProfileById_ :: DB.Connection -> User -> ProfileId -> IO ()
deleteUnusedIncognitoProfileById_ db User {userId} profileId =
DB.execute
@@ -417,18 +425,28 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId =
|]
(userId, profileId, userId, profileId, userId, profileId)
type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. (Maybe AConnectionRequestUri, Maybe GroupMemberId, BoolInt, Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64)
type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. (Maybe AConnectionRequestUri, Maybe AConnShortLink, Maybe GroupMemberId, BoolInt, Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64)
type ContactRow = Only ContactId :. ContactRow'
toContact :: VersionRangeChat -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (connReqToConnect, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) :. connRow) =
toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (connFullLink, connShortLink, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
activeConn = toMaybeConnection vr connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
incognito = maybe False connIncognito activeConn
mergedPreferences = contactUserPreferences user userPreferences preferences incognito
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, connReqToConnect, contactGroupMemberId, contactGrpInvSent, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
connLinkToConnect = toACreatedConnLink_ connFullLink connShortLink
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, connLinkToConnect, contactGroupMemberId, contactGrpInvSent, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
toACreatedConnLink_ :: Maybe AConnectionRequestUri -> Maybe AConnShortLink -> Maybe ACreatedConnLink
toACreatedConnLink_ connFullLink connShortLink = case (connFullLink, connShortLink) of
(Nothing, _) -> Nothing
(Just (ACR m cr), Nothing) -> Just $ ACCL m (CCLink cr Nothing)
(Just (ACR m cr), Just (ACSL m' l)) -> case (m, m') of
(SCMInvitation, SCMInvitation) -> Just $ ACCL SCMInvitation (CCLink cr (Just l))
(SCMContact, SCMContact) -> Just $ ACCL SCMContact (CCLink cr (Just l))
_ -> Nothing
getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile
getProfileById db userId profileId =
@@ -579,18 +597,21 @@ safeDeleteLDN db User {userId} localDisplayName = do
type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe MemberId)
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Text, Maybe Text, Maybe ImageData, Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime, Maybe ConnReqContact) :. BusinessChatInfoRow :. (Maybe UIThemeEntityOverrides, Maybe CustomData, Maybe Int64, Int) :. GroupMemberRow
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Text, Maybe Text, Maybe ImageData, Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime, Maybe ConnReqContact, Maybe ShortLinkContact) :. BusinessChatInfoRow :. (Maybe UIThemeEntityOverrides, Maybe CustomData, Maybe Int64, Int) :. GroupMemberRow
type GroupMemberRow = (Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, Maybe Preferences) :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime)
toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, localAlias, description, image, enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt, connReqToConnect) :. businessRow :. (uiThemes, customData, chatItemTTL, membersRequireAttention) :. userMemberRow) =
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, localAlias, description, image, enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt, connFullLink, connShortLink) :. businessRow :. (uiThemes, customData, chatItemTTL, membersRequireAttention) :. userMemberRow) =
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences, memberAdmission}
businessChat = toBusinessChatInfo businessRow
in GroupInfo {groupId, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, connReqToConnect, chatTags, chatItemTTL, uiThemes, customData, membersRequireAttention}
connLinkToConnect = case (connFullLink, connShortLink) of
(Nothing, _) -> Nothing
(Just fullLink, shortLink_) -> Just $ CCLink fullLink shortLink_
in GroupInfo {groupId, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, connLinkToConnect, chatTags, chatItemTTL, uiThemes, customData, membersRequireAttention}
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences) :. (createdAt, updatedAt) :. (supportChatTs_, supportChatUnread, supportChatMemberAttention, supportChatMentions, supportChatLastMsgFromMemberTs)) =
@@ -623,7 +644,7 @@ groupInfoQuery =
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_req_to_connect,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupMember - membership

12
src/Simplex/Chat/Types.hs
View File

@@ -51,7 +51,7 @@ import Simplex.Chat.Types.UITheme
import Simplex.Chat.Types.Util
import Simplex.FileTransfer.Description (FileDigest)
import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri, ACorrId, AEventTag (..), AEvtTag (..), ConnId, ConnShortLink, ConnectionLink, ConnectionMode (..), ConnectionRequestUri, CreatedConnLink, InvitationId, SAEntity (..), UserId)
import Simplex.Messaging.Agent.Protocol (ACorrId, ACreatedConnLink, AEventTag (..), AEvtTag (..), ConnId, ConnShortLink, ConnectionLink, ConnectionMode (..), ConnectionRequestUri, CreatedConnLink, InvitationId, SAEntity (..), UserId)
import Simplex.Messaging.Agent.Store.DB (Binary (..), blobFieldDecoder, fromTextField_)
import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport, pattern PQEncOff)
@@ -188,7 +188,7 @@ data Contact = Contact
createdAt :: UTCTime,
updatedAt :: UTCTime,
chatTs :: Maybe UTCTime,
connReqToConnect :: Maybe AConnectionRequestUri,
connLinkToConnect :: Maybe ACreatedConnLink,
contactGroupMemberId :: Maybe GroupMemberId,
contactGrpInvSent :: Bool,
chatTags :: [ChatTagId],
@@ -419,7 +419,7 @@ data GroupInfo = GroupInfo
updatedAt :: UTCTime,
chatTs :: Maybe UTCTime,
userMemberProfileSentAt :: Maybe UTCTime,
connReqToConnect :: Maybe ConnReqContact,
connLinkToConnect :: Maybe CreatedLinkContact,
chatTags :: [ChatTagId],
chatItemTTL :: Maybe Int64,
uiThemes :: Maybe UIThemeEntityOverrides,
@@ -456,6 +456,8 @@ data GroupSummary = GroupSummary
data ContactOrGroup = CGContact Contact | CGGroup GroupInfo [GroupMember]
data ContactOrGroupMemberId = CGMContactId ContactId | CGMGroupMemberId GroupMemberId
contactAndGroupIds :: ContactOrGroup -> (Maybe ContactId, Maybe GroupId)
contactAndGroupIds = \case
CGContact Contact {contactId} -> (Just contactId, Nothing)
@@ -654,7 +656,7 @@ deriving newtype instance FromField ImageData
-- TODO [short links] StrEncoding instances?
data ContactShortLinkData = ContactShortLinkData
{ profile :: Profile,
welcomeMessage :: Maybe Text
welcomeMsg :: Maybe Text
}
deriving (Show)
@@ -1481,6 +1483,8 @@ type CreatedLinkContact = CreatedConnLink 'CMContact
type ConnLinkContact = ConnectionLink 'CMContact
type ShortLinkInvitation = ConnShortLink 'CMInvitation
type ShortLinkContact = ConnShortLink 'CMContact
data Connection = Connection

23
src/Simplex/Chat/View.hs
View File

@@ -189,9 +189,12 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
CRInvitation u ccLink _ -> ttyUser u $ viewConnReqInvitation ccLink
CRConnectionIncognitoUpdated u c -> ttyUser u $ viewConnectionIncognitoUpdated c
CRConnectionUserChanged u c c' nu -> ttyUser u $ viewConnectionUserChanged u c nu c'
CRConnectionPlan u _ connectionPlan -> ttyUser u $ viewConnectionPlan cfg connectionPlan
CRConnectionPlan u connLink connectionPlan -> ttyUser u $ viewConnectionPlan cfg connLink connectionPlan
CRNewPreparedContact u c -> ttyUser u [ttyContact' c <> ": contact is prepared"]
CRNewPreparedGroup u g -> ttyUser u [ttyGroup' g <> ": group is prepared"]
CRSentConfirmation u _ -> ttyUser u ["confirmation sent!"]
CRSentInvitation u _ customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
CRStartedConnectionToContact u c -> ttyUser u [ttyContact' c <> ": connection started"]
CRSentInvitationToContact u _c customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
CRItemsReadForChat u _chatId -> ttyUser u ["items read for chat"]
CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"]
@@ -988,7 +991,13 @@ viewConnReqInvitation (CCLink cReq shortLink) =
"",
"and ask them to connect: " <> highlight' "/c <invitation_link_above>"
]
<> ["The invitation link for old clients: " <> plain cReqStr | isJust shortLink]
<>
if isJust shortLink
then
[ "The invitation link for old clients:",
plain cReqStr
]
else []
where
cReqStr = strEncode $ simplexChatInvitation cReq
@@ -1815,10 +1824,10 @@ viewConnectionUserChanged User {localDisplayName = n} PendingContactConnection {
where
cReqStr = strEncode $ simplexChatInvitation cReq
viewConnectionPlan :: ChatConfig -> ConnectionPlan -> [StyledString]
viewConnectionPlan ChatConfig {logLevel, testView} = \case
viewConnectionPlan :: ChatConfig -> ACreatedConnLink -> ConnectionPlan -> [StyledString]
viewConnectionPlan ChatConfig {logLevel, testView} connLink = \case
CPInvitationLink ilp -> case ilp of
ILPOk _contactSLinkData -> [invLink "ok to connect"]
ILPOk contactSLinkData -> [invLink "ok to connect"] <> [viewJSON contactSLinkData | testView]
ILPOwnLink -> [invLink "own link"]
ILPConnecting Nothing -> [invLink "connecting"]
ILPConnecting (Just ct) -> [invLink ("connecting to contact " <> ttyContact' ct)]
@@ -1829,7 +1838,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} = \case
where
invLink = ("invitation link: " <>)
CPContactAddress cap -> case cap of
CAPOk _contactSLinkData -> [ctAddr "ok to connect"]
CAPOk contactSLinkData -> [ctAddr "ok to connect"] <> [viewJSON contactSLinkData | testView]
CAPOwnLink -> [ctAddr "own address"]
CAPConnectingConfirmReconnect -> [ctAddr "connecting, allowed to reconnect"]
CAPConnectingProhibit ct -> [ctAddr ("connecting to contact " <> ttyContact' ct)]
@@ -1841,7 +1850,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} = \case
where
ctAddr = ("contact address: " <>)
CPGroupLink glp -> case glp of
GLPOk _groupSLinkData -> [grpLink "ok to connect"]
GLPOk groupSLinkData -> [grpLink "ok to connect"] <> [viewJSON groupSLinkData | testView]
GLPOwnLink g -> [grpLink "own link for group " <> ttyGroup' g]
GLPConnectingConfirmReconnect -> [grpLink "connecting, allowed to reconnect"]
GLPConnectingProhibit Nothing -> [grpLink "connecting"]