mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-24 17:25:42 +00:00
core: update short link data (#5983)
This commit is contained in:
spaced4ndy
@@ -680,7 +680,7 @@ data ChatResponse
|
||||
| CRUserPrivacy {user :: User, updatedUser :: User}
|
||||
| CRVersionInfo {versionInfo :: CoreVersionInfo, chatMigrations :: [UpMigration], agentMigrations :: [UpMigration]}
|
||||
| CRInvitation {user :: User, connLinkInvitation :: CreatedLinkInvitation, connection :: PendingContactConnection}
|
||||
| CRConnectionIncognitoUpdated {user :: User, toConnection :: PendingContactConnection}
|
||||
| CRConnectionIncognitoUpdated {user :: User, toConnection :: PendingContactConnection, customUserProfile :: Maybe Profile}
|
||||
| CRConnectionUserChanged {user :: User, fromConnection :: PendingContactConnection, toConnection :: PendingContactConnection, newUser :: User}
|
||||
| CRConnectionPlan {user :: User, connLink :: ACreatedConnLink, connectionPlan :: ConnectionPlan}
|
||||
| CRNewPreparedContact {user :: User, contact :: Contact}
|
||||
|
||||
@@ -1276,7 +1276,6 @@ 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
|
||||
@@ -1697,13 +1696,13 @@ processChatCommand' vr = \case
|
||||
conn' <- withFastStore' $ \db -> do
|
||||
pId <- createIncognitoProfile db user incognitoProfile
|
||||
updatePCCIncognito db user conn (Just pId) sLnk
|
||||
pure $ CRConnectionIncognitoUpdated user conn'
|
||||
pure $ CRConnectionIncognitoUpdated user conn' (Just incognitoProfile)
|
||||
(ConnNew, Just pId, False) -> do
|
||||
sLnk <- updatePCCShortLinkData conn (ContactShortLinkData (userProfileToSend user Nothing Nothing False) Nothing)
|
||||
conn' <- withFastStore' $ \db -> do
|
||||
deletePCCIncognitoProfile db user pId
|
||||
updatePCCIncognito db user conn Nothing sLnk
|
||||
pure $ CRConnectionIncognitoUpdated user conn'
|
||||
pure $ CRConnectionIncognitoUpdated user conn' Nothing
|
||||
_ -> throwChatError CEConnectionIncognitoChangeProhibited
|
||||
APIChangeConnectionUser connId newUserId -> withUser $ \user@User {userId} -> do
|
||||
conn <- withFastStore $ \db -> getPendingContactConnection db userId connId
|
||||
@@ -1851,7 +1850,7 @@ processChatCommand' vr = \case
|
||||
deleteAgentConnectionAsync $ aConnId conn
|
||||
withFastStore' (`deleteUserAddress` user)
|
||||
let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing}
|
||||
r <- updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing
|
||||
r <- updateProfile_ user p' False $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing
|
||||
let user' = case r of
|
||||
CRUserProfileUpdated u' _ _ _ -> u'
|
||||
_ -> user
|
||||
@@ -1863,37 +1862,37 @@ processChatCommand' vr = \case
|
||||
ShowMyAddress -> withUser' $ \User {userId} ->
|
||||
processChatCommand $ APIShowMyAddress userId
|
||||
APIAddMyAddressShortLink userId -> withUserId' userId $ \user -> do
|
||||
(ucl@UserContactLink {connLinkContact = CCLink connFullLink _sLnk_, autoAccept}, conn) <-
|
||||
withFastStore $ \db -> (,) <$> getUserAddress db user <*> getUserAddressConnection db vr user
|
||||
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
|
||||
let autoAccept' = autoAccept >>= \aa -> Just aa {acceptIncognito = False}
|
||||
ucl' = (ucl :: UserContactLink) {connLinkContact = CCLink connFullLink (Just sLnk), shortLinkDataSet = True, autoAccept = autoAccept'}
|
||||
pure $ CRUserContactLink user ucl'
|
||||
Nothing -> throwChatError $ CEException "no user contact link id"
|
||||
ucl <- withFastStore $ \db -> getUserAddress db user
|
||||
setMyAddressData user ucl
|
||||
APISetProfileAddress userId False -> withUserId userId $ \user@User {profile = p} -> do
|
||||
let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing}
|
||||
updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing
|
||||
updateProfile_ user p' True $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing
|
||||
APISetProfileAddress userId True -> withUserId userId $ \user@User {profile = p} -> do
|
||||
ucl@UserContactLink {connLinkContact = CCLink cReq _} <- withFastStore (`getUserAddress` user)
|
||||
-- TODO [short links] replace with short links
|
||||
let p' = (fromLocalProfile p :: Profile) {contactLink = Just $ CLFull cReq}
|
||||
updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user $ Just ucl
|
||||
updateProfile_ user p' True $ withFastStore' $ \db -> setUserProfileContactLink db user $ Just ucl
|
||||
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
|
||||
UserContactLink {shortLinkDataSet} <- withFastStore (`getUserAddress` user)
|
||||
ucl@UserContactLink {userContactLinkId, shortLinkDataSet, autoAccept} <- withFastStore (`getUserAddress` user)
|
||||
forM_ autoAccept_ $ \AutoAccept {businessAddress, acceptIncognito} -> do
|
||||
when (shortLinkDataSet && acceptIncognito) $ throwCmdError "incognito not allowed for address with short link data"
|
||||
when (businessAddress && acceptIncognito) $ throwCmdError "requests to business address cannot be accepted incognito"
|
||||
contactLink <- withFastStore (\db -> updateUserAddressAutoAccept db user autoAccept_)
|
||||
pure $ CRUserContactLinkUpdated user contactLink
|
||||
let ucl' = ucl {autoAccept = autoAccept_}
|
||||
ucl'' <-
|
||||
if shortLinkDataSet && replyMsgChanged autoAccept autoAccept_
|
||||
then setMyAddressData user ucl' >>= \case
|
||||
CRUserContactLink _ ucl'' -> pure ucl''
|
||||
cr -> throwCmdError $ "unexpected response from setMyAddressData: " <> show cr
|
||||
else pure ucl'
|
||||
withFastStore' $ \db -> updateUserAddressAutoAccept db userContactLinkId autoAccept_
|
||||
pure $ CRUserContactLinkUpdated user ucl''
|
||||
where
|
||||
replyMsgChanged prevAutoAccept newAutoAccept =
|
||||
let prevReplyMsg = prevAutoAccept >>= autoReply
|
||||
newReplyMsg = newAutoAccept >>= autoReply
|
||||
in newReplyMsg /= prevReplyMsg
|
||||
AddressAutoAccept autoAccept_ -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIAddressAutoAccept userId autoAccept_
|
||||
AcceptContact incognito cName -> withUser $ \User {userId} -> do
|
||||
@@ -2434,7 +2433,6 @@ 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}
|
||||
@@ -2478,18 +2476,11 @@ processChatCommand' vr = \case
|
||||
gLnk <- withFastStore $ \db -> getGroupLink db user gInfo
|
||||
pure $ CRGroupLink user gInfo gLnk
|
||||
APIAddGroupShortLink groupId -> withUser $ \user -> do
|
||||
(gInfo, gLink, conn) <- withFastStore $ \db -> do
|
||||
(gInfo, gLink) <- withFastStore $ \db -> do
|
||||
gInfo <- getGroupInfo db vr user groupId
|
||||
gLink <- getGroupLink db user gInfo
|
||||
conn <- getGroupLinkConnection db vr user gInfo
|
||||
pure (gInfo, gLink, conn)
|
||||
let GroupInfo {groupProfile} = gInfo
|
||||
userData = encodeShortLinkData (GroupShortLinkData groupProfile)
|
||||
GroupLink {groupLinkId} = gLink
|
||||
crClientData = encodeJSON $ CRDataGroup groupLinkId
|
||||
sLnk <- shortenShortLink' . toShortGroupLink =<< withAgent (\a -> setConnShortLink a (aConnId conn) SCMContact userData (Just crClientData))
|
||||
gLink' <- withFastStore' $ \db -> setGroupLinkShortLink db gLink sLnk
|
||||
pure $ CRGroupLink user gInfo gLink'
|
||||
pure (gInfo, gLink)
|
||||
setGroupLinkData user gInfo gLink
|
||||
APICreateMemberContact gId gMemberId -> withUser $ \user -> do
|
||||
(g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId
|
||||
assertUserGroupRole g GRAuthor
|
||||
@@ -2983,9 +2974,9 @@ processChatCommand' vr = \case
|
||||
when (fromInteger fileSize > maxFileSize) $ throwChatError $ CEFileSize f
|
||||
pure fileSize
|
||||
updateProfile :: User -> Profile -> CM ChatResponse
|
||||
updateProfile user p' = updateProfile_ user p' $ withFastStore $ \db -> updateUserProfile db user p'
|
||||
updateProfile_ :: User -> Profile -> CM User -> CM ChatResponse
|
||||
updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n'} updateUser
|
||||
updateProfile user p' = updateProfile_ user p' True $ withFastStore $ \db -> updateUserProfile db user p'
|
||||
updateProfile_ :: User -> Profile -> Bool -> CM User -> CM ChatResponse
|
||||
updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n'} shouldUpdateAddressData updateUser
|
||||
| p' == fromLocalProfile p = pure $ CRUserProfileNoChange user
|
||||
| otherwise = do
|
||||
when (n /= n') $ checkValidName n'
|
||||
@@ -2994,41 +2985,63 @@ processChatCommand' vr = \case
|
||||
user' <- updateUser
|
||||
asks currentUser >>= atomically . (`writeTVar` Just user')
|
||||
withChatLock "updateProfile" . procCmd $ do
|
||||
let changedCts_ = L.nonEmpty $ foldr (addChangedProfileContact user') [] contacts
|
||||
summary <- case changedCts_ of
|
||||
Nothing -> pure $ UserProfileUpdateSummary 0 0 []
|
||||
Just changedCts -> do
|
||||
let idsEvts = L.map ctSndEvent changedCts
|
||||
msgReqs_ <- lift $ L.zipWith ctMsgReq changedCts <$> createSndMessages idsEvts
|
||||
(errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_
|
||||
unless (null errs) $ toView $ CEvtChatErrors errs
|
||||
let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts
|
||||
lift $ createContactsSndFeatureItems user' changedCts'
|
||||
pure
|
||||
UserProfileUpdateSummary
|
||||
{ updateSuccesses = length cts,
|
||||
updateFailures = length errs,
|
||||
changedContacts = map (\ChangedProfileContact {ct'} -> ct') changedCts'
|
||||
}
|
||||
when shouldUpdateAddressData $ setMyAddressData' user'
|
||||
summary <- sendUpdateToContacts user' contacts
|
||||
pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' summary
|
||||
where
|
||||
-- [incognito] filter out contacts with whom user has incognito connections
|
||||
addChangedProfileContact :: User -> Contact -> [ChangedProfileContact] -> [ChangedProfileContact]
|
||||
addChangedProfileContact user' ct changedCts = case contactSendConn_ ct' of
|
||||
Right conn
|
||||
| not (connIncognito conn) && mergedProfile' /= mergedProfile ->
|
||||
ChangedProfileContact ct ct' mergedProfile' conn : changedCts
|
||||
_ -> changedCts
|
||||
setMyAddressData' :: User -> CM ()
|
||||
setMyAddressData' user' = do
|
||||
withFastStore' (\db -> runExceptT $ getUserAddress db user) >>= \case
|
||||
Right ucl@UserContactLink {shortLinkDataSet}
|
||||
| shortLinkDataSet -> void $ setMyAddressData user' ucl
|
||||
_ -> pure ()
|
||||
sendUpdateToContacts :: User -> [Contact] -> CM UserProfileUpdateSummary
|
||||
sendUpdateToContacts user' contacts = do
|
||||
let changedCts_ = L.nonEmpty $ foldr addChangedProfileContact [] contacts
|
||||
case changedCts_ of
|
||||
Nothing -> pure $ UserProfileUpdateSummary 0 0 []
|
||||
Just changedCts -> do
|
||||
let idsEvts = L.map ctSndEvent changedCts
|
||||
msgReqs_ <- lift $ L.zipWith ctMsgReq changedCts <$> createSndMessages idsEvts
|
||||
(errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_
|
||||
unless (null errs) $ toView $ CEvtChatErrors errs
|
||||
let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts
|
||||
lift $ createContactsSndFeatureItems user' changedCts'
|
||||
pure
|
||||
UserProfileUpdateSummary
|
||||
{ updateSuccesses = length cts,
|
||||
updateFailures = length errs,
|
||||
changedContacts = map (\ChangedProfileContact {ct'} -> ct') changedCts'
|
||||
}
|
||||
where
|
||||
mergedProfile = userProfileToSend user Nothing (Just ct) False
|
||||
ct' = updateMergedPreferences user' ct
|
||||
mergedProfile' = userProfileToSend user' Nothing (Just ct') False
|
||||
ctSndEvent :: ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json)
|
||||
ctSndEvent ChangedProfileContact {mergedProfile', conn = Connection {connId}} = (ConnectionId connId, XInfo mergedProfile')
|
||||
ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq
|
||||
ctMsgReq ChangedProfileContact {conn} =
|
||||
fmap $ \SndMessage {msgId, msgBody} ->
|
||||
(conn, MsgFlags {notification = hasNotification XInfo_}, (vrValue msgBody, [msgId]))
|
||||
-- [incognito] filter out contacts with whom user has incognito connections
|
||||
addChangedProfileContact :: Contact -> [ChangedProfileContact] -> [ChangedProfileContact]
|
||||
addChangedProfileContact ct changedCts = case contactSendConn_ ct' of
|
||||
Right conn
|
||||
| not (connIncognito conn) && mergedProfile' /= mergedProfile ->
|
||||
ChangedProfileContact ct ct' mergedProfile' conn : changedCts
|
||||
_ -> changedCts
|
||||
where
|
||||
mergedProfile = userProfileToSend user Nothing (Just ct) False
|
||||
ct' = updateMergedPreferences user' ct
|
||||
mergedProfile' = userProfileToSend user' Nothing (Just ct') False
|
||||
ctSndEvent :: ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json)
|
||||
ctSndEvent ChangedProfileContact {mergedProfile', conn = Connection {connId}} = (ConnectionId connId, XInfo mergedProfile')
|
||||
ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq
|
||||
ctMsgReq ChangedProfileContact {conn} =
|
||||
fmap $ \SndMessage {msgId, msgBody} ->
|
||||
(conn, MsgFlags {notification = hasNotification XInfo_}, (vrValue msgBody, [msgId]))
|
||||
setMyAddressData :: User -> UserContactLink -> CM ChatResponse
|
||||
setMyAddressData user ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _sLnk_, autoAccept} = do
|
||||
conn <- withFastStore $ \db -> getUserAddressConnection db vr user
|
||||
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)
|
||||
withFastStore' $ \db -> setUserContactLinkShortLink db userContactLinkId sLnk
|
||||
let autoAccept' = autoAccept >>= \aa -> Just aa {acceptIncognito = False}
|
||||
ucl' = (ucl :: UserContactLink) {connLinkContact = CCLink connFullLink (Just sLnk), shortLinkDataSet = True, autoAccept = autoAccept'}
|
||||
pure $ CRUserContactLink user ucl'
|
||||
updateContactPrefs :: User -> Contact -> Preferences -> CM ChatResponse
|
||||
updateContactPrefs _ ct@Contact {activeConn = Nothing} _ = throwChatError $ CEContactNotActive ct
|
||||
updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs'
|
||||
@@ -3040,7 +3053,7 @@ processChatCommand' vr = \case
|
||||
let mergedProfile = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct) False
|
||||
mergedProfile' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False
|
||||
when (mergedProfile' /= mergedProfile) $
|
||||
withContactLock "updateProfile" (contactId' ct) $ do
|
||||
withContactLock "updateContactPrefs" (contactId' ct) $ do
|
||||
void (sendDirectContactMessage user ct' $ XInfo mergedProfile') `catchChatError` eToView
|
||||
lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct'
|
||||
pure $ CRContactPrefsUpdated user ct ct'
|
||||
@@ -3063,14 +3076,30 @@ processChatCommand' vr = \case
|
||||
recipients = filter memberCurrentOrPending newMs
|
||||
sendGroupMessage user g' Nothing recipients $ XGrpPrefs ps'
|
||||
Nothing -> do
|
||||
setGroupLinkData' g'
|
||||
let recipients = filter memberCurrentOrPending ms
|
||||
sendGroupMessage user g' Nothing recipients (XGrpInfo p')
|
||||
where
|
||||
setGroupLinkData' :: GroupInfo -> CM ()
|
||||
setGroupLinkData' g' = do
|
||||
withFastStore' (\db -> runExceptT $ getGroupLink db user g') >>= \case
|
||||
Right gLink@GroupLink {shortLinkDataSet}
|
||||
| shortLinkDataSet -> void $ setGroupLinkData user g' gLink
|
||||
_ -> pure ()
|
||||
let cd = CDGroupSnd g' Nothing
|
||||
unless (sameGroupProfileInfo p p') $ do
|
||||
ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p')
|
||||
toView $ CEvtNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat g' Nothing) ci]
|
||||
createGroupFeatureChangedItems user cd CISndGroupFeature g g'
|
||||
pure $ CRGroupUpdated user g g' Nothing
|
||||
setGroupLinkData :: User -> GroupInfo -> GroupLink -> CM ChatResponse
|
||||
setGroupLinkData user gInfo@GroupInfo {groupProfile} gLink@GroupLink {groupLinkId} = do
|
||||
conn <- withFastStore $ \db -> getGroupLinkConnection db vr user gInfo
|
||||
let userData = encodeShortLinkData (GroupShortLinkData groupProfile)
|
||||
crClientData = encodeJSON $ CRDataGroup groupLinkId
|
||||
sLnk <- shortenShortLink' . toShortGroupLink =<< withAgent (\a -> setConnShortLink a (aConnId conn) SCMContact userData (Just crClientData))
|
||||
gLink' <- withFastStore' $ \db -> setGroupLinkShortLink db gLink sLnk
|
||||
pure $ CRGroupLink user gInfo gLink'
|
||||
checkValidName :: GroupName -> CM ()
|
||||
checkValidName displayName = do
|
||||
when (T.null displayName) $ throwChatError CEInvalidDisplayName {displayName, validName = ""}
|
||||
@@ -3290,7 +3319,7 @@ processChatCommand' vr = \case
|
||||
case ct of
|
||||
CCTContact ->
|
||||
withFastStore' (\db -> getUserContactLinkViaShortLink db user l') >>= \case
|
||||
Just (UserContactLink (CCLink cReq _) _ _) -> pure (ACCL SCMContact $ CCLink cReq (Just l'), CPContactAddress CAPOwnLink)
|
||||
Just UserContactLink {connLinkContact = CCLink cReq _} -> pure (ACCL SCMContact $ CCLink cReq (Just l'), CPContactAddress CAPOwnLink)
|
||||
Nothing -> do
|
||||
(cReq, cData) <- getShortLinkConnReq user l'
|
||||
let contactSLinkData_ = decodeShortLinkData $ linkUserData cData
|
||||
@@ -3412,9 +3441,9 @@ processChatCommand' vr = \case
|
||||
CSLContact _ ct srv linkKey -> CSLContact SLSServer ct srv linkKey
|
||||
restoreShortLink' l = (`restoreShortLink` l) <$> asks (shortLinkPresetServers . config)
|
||||
encodeShortLinkData :: J.ToJSON a => a -> ByteString
|
||||
encodeShortLinkData = encodeUtf8 . encodeJSON
|
||||
encodeShortLinkData = LB.toStrict . J.encode
|
||||
decodeShortLinkData :: J.FromJSON a => ByteString -> Maybe a
|
||||
decodeShortLinkData = decodeJSON . safeDecodeUtf8
|
||||
decodeShortLinkData = J.decodeStrict
|
||||
updatePCCShortLinkData :: J.ToJSON a => PendingContactConnection -> a -> CM (Maybe ShortLinkInvitation)
|
||||
updatePCCShortLinkData conn@PendingContactConnection {connLinkInv} shortLinkData = do
|
||||
let short = isJust $ connShortLink =<< connLinkInv
|
||||
|
||||
@@ -1035,8 +1035,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
Just BusinessChatInfo {customerId, chatType = BCCustomer}
|
||||
| joiningMemberId == customerId -> useReply <$> withStore (`getUserAddress` user)
|
||||
where
|
||||
useReply UserContactLink {autoAccept} = case autoAccept of
|
||||
Just AutoAccept {businessAddress, autoReply} | businessAddress -> autoReply
|
||||
useReply UserContactLink {autoAccept, shortLinkDataSet} = case autoAccept of
|
||||
Just AutoAccept {businessAddress, autoReply}
|
||||
| businessAddress && (not shortLinkDataSet || connChatVersion < shortLinkDataVersion) ->
|
||||
autoReply
|
||||
_ -> Nothing
|
||||
_ -> pure Nothing
|
||||
send mc = do
|
||||
@@ -1237,7 +1239,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
forM_ mc_ $ \mc ->
|
||||
createInternalChatItem user (CDDirectRcv ct) (CIRcvMsgContent mc) Nothing
|
||||
toView $ CEvtReceivedContactRequest user cReq ct_
|
||||
Just AutoAccept {acceptIncognito, businessAddress}
|
||||
Just AutoAccept {businessAddress, acceptIncognito, autoReply}
|
||||
| businessAddress ->
|
||||
if isSimplexTeam && v < businessChatsVersion
|
||||
then
|
||||
@@ -1245,6 +1247,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
Just ct -> toView $ CEvtContactRequestAlreadyAccepted user ct
|
||||
Nothing -> do
|
||||
ct <- acceptContactRequestAsync user uclId invId chatVRange p xContactId_ reqPQSup Nothing
|
||||
forM_ autoReply $ \arMC ->
|
||||
when (shortLinkDataSet && v >= shortLinkDataVersion) $
|
||||
createInternalChatItem user (CDDirectSnd ct) (CISndMsgContent arMC) Nothing
|
||||
forM_ mc_ $ \mc ->
|
||||
createInternalChatItem user (CDDirectRcv ct) (CIRcvMsgContent mc) Nothing
|
||||
toView $ CEvtAcceptingContactRequest user ct
|
||||
@@ -1253,6 +1258,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
Just gInfo -> toView $ CEvtBusinessRequestAlreadyAccepted user gInfo
|
||||
Nothing -> do
|
||||
(gInfo, clientMember) <- acceptBusinessJoinRequestAsync user uclId invId chatVRange p xContactId_
|
||||
forM_ autoReply $ \arMC ->
|
||||
when (shortLinkDataSet && v >= shortLinkDataVersion) $
|
||||
createInternalChatItem user (CDGroupSnd gInfo Nothing) (CISndMsgContent arMC) Nothing
|
||||
forM_ mc_ $ \mc ->
|
||||
createInternalChatItem user (CDGroupRcv gInfo Nothing clientMember) (CIRcvMsgContent mc) Nothing
|
||||
toView $ CEvtAcceptingBusinessRequest user gInfo
|
||||
@@ -1267,6 +1275,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
then Just . NewIncognito <$> liftIO generateRandomProfile
|
||||
else pure Nothing
|
||||
ct <- acceptContactRequestAsync user uclId invId chatVRange p xContactId_ reqPQSup incognitoProfile
|
||||
forM_ autoReply $ \arMC ->
|
||||
when (shortLinkDataSet && v >= shortLinkDataVersion) $
|
||||
createInternalChatItem user (CDDirectSnd ct) (CISndMsgContent arMC) Nothing
|
||||
forM_ mc_ $ \mc ->
|
||||
createInternalChatItem user (CDDirectRcv ct) (CIRcvMsgContent mc) Nothing
|
||||
toView $ CEvtAcceptingContactRequest user ct
|
||||
|
||||
@@ -269,7 +269,7 @@ deleteGroupLink db User {userId} GroupInfo {groupId} = do
|
||||
DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND group_id = ?" (userId, groupId)
|
||||
|
||||
data GroupLink = GroupLink
|
||||
{ userContactLinkId :: Int64, -- db id
|
||||
{ userContactLinkId :: Int64,
|
||||
connLinkContact :: CreatedLinkContact,
|
||||
shortLinkDataSet :: Bool,
|
||||
groupLinkId :: GroupLinkId,
|
||||
|
||||
@@ -450,7 +450,8 @@ data UserMsgReceiptSettings = UserMsgReceiptSettings
|
||||
deriving (Show)
|
||||
|
||||
data UserContactLink = UserContactLink
|
||||
{ connLinkContact :: CreatedLinkContact,
|
||||
{ userContactLinkId :: Int64,
|
||||
connLinkContact :: CreatedLinkContact,
|
||||
shortLinkDataSet :: Bool,
|
||||
autoAccept :: Maybe AutoAccept
|
||||
}
|
||||
@@ -473,9 +474,9 @@ $(J.deriveJSON defaultJSON ''AutoAccept)
|
||||
|
||||
$(J.deriveJSON defaultJSON ''UserContactLink)
|
||||
|
||||
toUserContactLink :: (ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt, BoolInt, BoolInt, Maybe MsgContent) -> UserContactLink
|
||||
toUserContactLink (connReq, shortLink, BI shortLinkDataSet, BI autoAccept, BI businessAddress, BI acceptIncognito, autoReply) =
|
||||
UserContactLink (CCLink connReq shortLink) shortLinkDataSet $
|
||||
toUserContactLink :: (Int64, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt, BoolInt, BoolInt, Maybe MsgContent) -> UserContactLink
|
||||
toUserContactLink (userContactLinkId, connReq, shortLink, BI shortLinkDataSet, BI autoAccept, BI businessAddress, BI acceptIncognito, autoReply) =
|
||||
UserContactLink userContactLinkId (CCLink connReq shortLink) shortLinkDataSet $
|
||||
if autoAccept then Just AutoAccept {businessAddress, acceptIncognito, autoReply} else Nothing
|
||||
|
||||
getUserAddress :: DB.Connection -> User -> ExceptT StoreError IO UserContactLink
|
||||
@@ -489,7 +490,7 @@ getUserContactLinkById db userId userContactLinkId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
|
||||
SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ? AND user_contact_link_id = ?
|
||||
|]
|
||||
@@ -525,7 +526,7 @@ getUserContactLinkViaShortLink db User {userId} shortLink =
|
||||
userContactLinkQuery :: Query
|
||||
userContactLinkQuery =
|
||||
[sql|
|
||||
SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
|
||||
SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
|
||||
FROM user_contact_links
|
||||
|]
|
||||
|
||||
@@ -558,21 +559,18 @@ getContactWithoutConnViaAddress db vr user@User {userId} (cReqSchema1, cReqSchem
|
||||
(userId, cReqSchema1, cReqSchema2)
|
||||
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db vr user) ctId_
|
||||
|
||||
updateUserAddressAutoAccept :: DB.Connection -> User -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink
|
||||
updateUserAddressAutoAccept db user@User {userId} autoAccept = do
|
||||
link <- getUserAddress db user
|
||||
liftIO updateUserAddressAutoAccept_ $> link {autoAccept}
|
||||
updateUserAddressAutoAccept :: DB.Connection -> Int64 -> Maybe AutoAccept -> IO ()
|
||||
updateUserAddressAutoAccept db userContactLinkId autoAccept =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE user_contact_links
|
||||
SET auto_accept = ?, business_address = ?, auto_accept_incognito = ?, auto_reply_msg_content = ?
|
||||
WHERE user_contact_link_id = ?
|
||||
|]
|
||||
(autoAcceptValues :. Only userContactLinkId)
|
||||
where
|
||||
updateUserAddressAutoAccept_ =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE user_contact_links
|
||||
SET auto_accept = ?, business_address = ?, auto_accept_incognito = ?, auto_reply_msg_content = ?
|
||||
WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL
|
||||
|]
|
||||
(ucl :. Only userId)
|
||||
ucl = case autoAccept of
|
||||
autoAcceptValues = case autoAccept of
|
||||
Just AutoAccept {businessAddress, acceptIncognito, autoReply} -> (BI True, BI businessAddress, BI acceptIncognito, autoReply)
|
||||
_ -> (BI False, BI False, BI False, Nothing)
|
||||
|
||||
|
||||
@@ -1362,14 +1362,6 @@ SEARCH group_profiles USING INTEGER PRIMARY KEY (rowid=?)
|
||||
LIST SUBQUERY 1
|
||||
SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
UPDATE user_contact_links
|
||||
SET auto_accept = ?, business_address = ?, auto_accept_incognito = ?, auto_reply_msg_content = ?
|
||||
WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL
|
||||
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=? AND local_display_name=?)
|
||||
|
||||
Query:
|
||||
INSERT INTO connections (
|
||||
user_id, agent_conn_id, conn_level, conn_status, conn_type, contact_id, custom_user_profile_id,
|
||||
@@ -3061,14 +3053,6 @@ Query:
|
||||
Plan:
|
||||
SEARCH commands USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ? AND user_contact_link_id = ?
|
||||
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id,
|
||||
conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id,
|
||||
@@ -3441,6 +3425,14 @@ Query:
|
||||
Plan:
|
||||
SEARCH usage_conditions USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ? AND user_contact_link_id = ?
|
||||
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
UPDATE chat_items
|
||||
SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
|
||||
@@ -4583,6 +4575,33 @@ Query:
|
||||
Plan:
|
||||
SEARCH server_operators USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
UPDATE user_contact_links
|
||||
SET auto_accept = ?, business_address = ?, auto_accept_incognito = ?, auto_reply_msg_content = ?
|
||||
WHERE user_contact_link_id = ?
|
||||
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
UPDATE user_contact_links
|
||||
SET short_link_contact = ?,
|
||||
short_link_data_set = ?
|
||||
WHERE user_contact_link_id = ?
|
||||
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
UPDATE user_contact_links
|
||||
SET short_link_contact = ?,
|
||||
short_link_data_set = ?,
|
||||
auto_accept_incognito = ?
|
||||
WHERE user_contact_link_id = ?
|
||||
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
UPDATE users
|
||||
SET view_pwd_hash = ?, view_pwd_salt = ?, show_ntfs = ?
|
||||
@@ -4853,27 +4872,6 @@ SEARCH c USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
CORRELATED SCALAR SUBQUERY 1
|
||||
SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group_member_id=?)
|
||||
|
||||
Query:
|
||||
SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ? AND conn_req_contact IN (?,?)
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?)
|
||||
|
||||
Query:
|
||||
SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=? AND local_display_name=?)
|
||||
|
||||
Query:
|
||||
SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ? AND short_link_contact = ?
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?)
|
||||
|
||||
Query:
|
||||
SELECT f.file_id, f.ci_file_status, f.file_path
|
||||
FROM chat_items i
|
||||
@@ -5129,6 +5127,27 @@ Query:
|
||||
Plan:
|
||||
SCAN usage_conditions
|
||||
|
||||
Query:
|
||||
SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ? AND conn_req_contact IN (?,?)
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?)
|
||||
|
||||
Query:
|
||||
SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=? AND local_display_name=?)
|
||||
|
||||
Query:
|
||||
SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ? AND short_link_contact = ?
|
||||
Plan:
|
||||
SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?)
|
||||
|
||||
Query: SELECT chat_item_id FROM chat_items WHERE (( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts < ? ) OR ( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts = ? AND chat_item_id < ? )) ORDER BY item_ts DESC, chat_item_id DESC LIMIT ?
|
||||
Plan:
|
||||
MULTI-INDEX OR
|
||||
|
||||
@@ -658,7 +658,6 @@ instance ToField ImageData where toField (ImageData t) = toField t
|
||||
|
||||
deriving newtype instance FromField ImageData
|
||||
|
||||
-- TODO [short links] StrEncoding instances?
|
||||
data ContactShortLinkData = ContactShortLinkData
|
||||
{ profile :: Profile,
|
||||
welcomeMsg :: Maybe Text
|
||||
|
||||
@@ -187,7 +187,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
|
||||
CRUserPrivacy u u' -> ttyUserPrefix hu outputRH u $ viewUserPrivacy u u'
|
||||
CRVersionInfo info _ _ -> viewVersionInfo logLevel info
|
||||
CRInvitation u ccLink _ -> ttyUser u $ viewConnReqInvitation ccLink
|
||||
CRConnectionIncognitoUpdated u c -> ttyUser u $ viewConnectionIncognitoUpdated c
|
||||
CRConnectionIncognitoUpdated u c customUserProfile -> ttyUser u $ viewConnectionIncognitoUpdated c customUserProfile testView
|
||||
CRConnectionUserChanged u c c' nu -> ttyUser u $ viewConnectionUserChanged u c nu c'
|
||||
CRConnectionPlan u connLink connectionPlan -> ttyUser u $ viewConnectionPlan cfg connLink connectionPlan
|
||||
CRNewPreparedContact u c -> ttyUser u [ttyContact' c <> ": contact is prepared"]
|
||||
@@ -1803,9 +1803,15 @@ viewConnectionAliasUpdated PendingContactConnection {pccConnId, localAlias}
|
||||
| localAlias == "" = ["connection " <> sShow pccConnId <> " alias removed"]
|
||||
| otherwise = ["connection " <> sShow pccConnId <> " alias updated: " <> plain localAlias]
|
||||
|
||||
viewConnectionIncognitoUpdated :: PendingContactConnection -> [StyledString]
|
||||
viewConnectionIncognitoUpdated PendingContactConnection {pccConnId, customUserProfileId}
|
||||
| isJust customUserProfileId = ["connection " <> sShow pccConnId <> " changed to incognito"]
|
||||
viewConnectionIncognitoUpdated :: PendingContactConnection -> Maybe Profile -> Bool -> [StyledString]
|
||||
viewConnectionIncognitoUpdated PendingContactConnection {pccConnId, customUserProfileId} incognitoProfile testView
|
||||
| isJust customUserProfileId =
|
||||
case incognitoProfile of
|
||||
Just profile
|
||||
| testView -> incognitoProfile' profile : message
|
||||
| otherwise -> message
|
||||
where message = ["connection " <> sShow pccConnId <> " changed to incognito"]
|
||||
Nothing -> ["unexpected response when changing connection, please report to developers"]
|
||||
| otherwise = ["connection " <> sShow pccConnId <> " changed to non incognito"]
|
||||
|
||||
viewConnectionUserChanged :: User -> PendingContactConnection -> User -> PendingContactConnection -> [StyledString]
|
||||
|
||||
Reference in New Issue
Block a user