dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-07-02 11:21:46 +00:00
Code Issues Packages Projects Releases Wiki Activity

update types and schema

Browse Source
This commit is contained in:
Evgeny @ SimpleX Chat
2026-06-26 13:57:49 +00:00
parent 2711f3b3ed
commit db963db47e
19 changed files with 310 additions and 537 deletions
Download Patch File Download Diff File Expand all files Collapse all files
cabal.project
+1 -6
View File
@@ -1,4 +1,4 @@
packages: .
packages: . ../simplexmq-4
-- packages: . ../simplexmq
-- packages: . ../simplexmq ../direct-sqlcipher ../sqlcipher-simple
@@ -18,11 +18,6 @@ package cryptostore
constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: b6d0bb585f34ce47f4c464b04e4f759d87812711
source-repository-package
type: git
location: https://github.com/simplex-chat/hs-socks.git
src/Simplex/Chat/Badges.hs
+10 -10
View File
@@ -27,8 +27,8 @@ module Simplex.Chat.Badges
maxXFTPFileSize,
maxFileSizeSupporter,
maxFileSizeLegend,
BadgePresHeaderTag (..),
BadgePresHeader (..),
ProofPresHeaderTag (..),
ProofPresHeader (..),
BadgePurchase (..),
BadgeMasterKey (..),
BadgeRequest (..),
@@ -197,9 +197,9 @@ maxXFTPFileSize = \case
-- presentation, not bound to any context; the 'T' tag marks it so master rejects it.
-- PHUnknown is the forward-compat catch-all for tags this version does not interpret.
data BadgePresHeaderTag = PHTestTag | PHUnknownTag Char
data ProofPresHeaderTag = PHTestTag | PHUnknownTag Char
instance StrEncoding BadgePresHeaderTag where
instance StrEncoding ProofPresHeaderTag where
strEncode = B.singleton . \case
PHTestTag -> 'T'
PHUnknownTag c -> c
@@ -209,11 +209,11 @@ instance StrEncoding BadgePresHeaderTag where
'T' -> PHTestTag
c -> PHUnknownTag c
data BadgePresHeader
data ProofPresHeader
= PHTest ByteString
| PHUnknown Char ByteString
instance StrEncoding BadgePresHeader where
instance StrEncoding ProofPresHeader where
strEncode = \case
PHTest nonce -> strEncode PHTestTag <> nonce
PHUnknown c b -> strEncode (PHUnknownTag c) <> b
@@ -223,8 +223,8 @@ instance StrEncoding BadgePresHeader where
PHUnknownTag c -> PHUnknown c <$> A.takeByteString
-- v6.5.x accepts both; v7 will reject PHTest/PHUnknown
badgePresHeaderAccepted :: BadgePresHeader -> Bool
badgePresHeaderAccepted = \case
proofPresHeaderAccepted :: ProofPresHeader -> Bool
proofPresHeaderAccepted = \case
PHTest _ -> True
PHUnknown _ _ -> True
@@ -311,7 +311,7 @@ generateBadgeProof pk (BadgeCredential keyIdx masterKey signature badgeInfo) ph
fmap (\p -> BadgeProof keyIdx ph p badgeInfo) <$> bbsProofGen pk signature bbsBadgeHeader ph bbsBadgeDisclosedIndexes (badgeMessages masterKey badgeInfo)
-- application-level proof generation with a semantic presentation header
badgeProof :: BBSPublicKey -> BadgeCredential -> BadgePresHeader -> IO (Either String BadgeProof)
badgeProof :: BBSPublicKey -> BadgeCredential -> ProofPresHeader -> IO (Either String BadgeProof)
badgeProof pk cred ph = generateBadgeProof pk cred (BBSPresHeader $ strEncode ph)
-- Recipient-side: verify a badge proof with the configured key its index points to.
@@ -324,7 +324,7 @@ verifyBadge keys b@(BadgeProof keyIdx _ _ _) = case M.lookup keyIdx keys of
verifyBadgeWith :: BBSPublicKey -> BadgeProof -> IO Bool
verifyBadgeWith pk (BadgeProof _ ph@(BBSPresHeader phBytes) proof badgeInfo)
| either (const False) badgePresHeaderAccepted (strDecode phBytes) =
| either (const False) proofPresHeaderAccepted (strDecode phBytes) =
bbsProofVerify pk proof bbsBadgeHeader ph bbsBadgeDisclosedIndexes bbsBadgeMessageCount (badgeInfoMessages badgeInfo)
| otherwise = pure False
src/Simplex/Chat/Controller.hs
+5 -4
View File
@@ -536,10 +536,11 @@ data ChatCommand
| APIConnectPreparedGroup {groupId :: GroupId, incognito :: IncognitoEnabled, ownerContact :: Maybe GroupOwnerContact, msgContent_ :: Maybe MsgContent}
| APIConnect {userId :: UserId, incognito :: IncognitoEnabled, preparedLink_ :: Maybe ACreatedConnLink} -- Maybe is used to report link parsing failure as special error
| Connect {incognito :: IncognitoEnabled, connTarget_ :: Maybe ConnectTarget}
| -- Resolves the simplex_name claim on the chat row (contact or group) via
-- RSLV and compares the resolved link to the peer's stored connection link.
-- Returns CRSimplexNameVerified with the boolean result (a match writes
-- simplex_name_verified_at); resolver / agent failures surface as ChatErrorAgent.
| -- Resolves the name claim on the chat row (contact or group) via RSLV and
-- compares the resolved link to the peer's stored connection link. Returns
-- CRSimplexNameVerified with the boolean result (persisted as the 3-state
-- contact_domain_verification / group_domain_verification); resolver / agent
-- failures surface as ChatErrorAgent.
APIVerifySimplexName {chatRef :: ChatRef}
| APIConnectContactViaAddress UserId IncognitoEnabled ContactId
| ConnectSimplex IncognitoEnabled -- UserId (not used in UI)
src/Simplex/Chat/Core.hs
+1 -1
View File
@@ -140,7 +140,7 @@ createActiveUser cc CoreChatOpts {chatRelay} = \case
displayName <- T.pack <$> withPrompt "display name" getLine
createUser loop False $ mkProfile displayName
where
mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, simplexName = Nothing}
mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
createUser onError clientService p =
execChatCommand' (CreateActiveUser NewUser {profile = Just p, pastTimestamp = False, userChatRelay = BoolDef chatRelay, clientService = BoolDef clientService}) 0 `runReaderT` cc >>= \case
Right (CRActiveUser user) -> pure user
src/Simplex/Chat/Library/Commands.hs
+29 -32
View File
@@ -2050,7 +2050,7 @@ processChatCommand cxt nm = \case
groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences
groupProfile = businessGroupProfile profile groupPreferences
gVar <- asks random
(gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user groupProfile True ccLink welcomeSharedMsgId False GRMember Nothing Nothing
(gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user groupProfile True ccLink welcomeSharedMsgId False GRMember Nothing
hostMember <- maybe (throwCmdError "no host member") pure hostMember_
void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart)
let cd = CDGroupRcv gInfo Nothing hostMember
@@ -2063,7 +2063,7 @@ processChatCommand cxt nm = \case
_ -> Chat cInfo [] emptyChatStats
pure $ CRNewPreparedChat user $ AChat SCTGroup chat
ACCL _ (CCLink cReq _) -> do
ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink welcomeSharedMsgId Nothing
ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink welcomeSharedMsgId
void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing Nothing (Just epochStart)
let cd = CDDirectRcv ct
createItem sharedMsgId content = createChatItem user cd False content sharedMsgId Nothing Nothing
@@ -2082,7 +2082,7 @@ processChatCommand cxt nm = \case
let useRelays = not direct
subRole <- if useRelays then asks $ channelSubscriberRole . config else pure GRMember
gVar <- asks random
(gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user gp False ccLink welcomeSharedMsgId useRelays subRole publicMemberCount_ Nothing
(gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user gp False ccLink welcomeSharedMsgId useRelays subRole publicMemberCount_
void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart)
let cd = maybe (CDChannelRcv gInfo Nothing) (CDGroupRcv gInfo Nothing) hostMember_
cInfo = GroupChat gInfo Nothing
@@ -4234,9 +4234,9 @@ processChatCommand cxt nm = \case
pure (con (linkConnReq fd), CPGroupLink (GLPKnown g' (BoolDef updated) ov (ListDef glOwners)))
connectPlanName :: User -> SimplexNameInfo -> CM (ACreatedConnLink, ConnectionPlan)
connectPlanName user ni@SimplexNameInfo {nameType, nameDomain} = case nameType of
-- The discriminator (`@` vs `#`) is encoded into the stored simplex_name
-- bytes via strEncode, so an `@contact` lookup can never match a group
-- row (and vice versa). Dispatch on nameType up front to skip a probe.
-- The discriminator (`@` vs `#`) is encoded into the stored name bytes via
-- strEncode, so an `@contact` lookup can never match a group row (and vice
-- versa). Dispatch on nameType up front to skip a probe.
NTContact -> do
ct_ <- withFastStore $ \db -> getContactBySimplexName db cxt user ni
case ct_ of
@@ -4711,12 +4711,10 @@ processChatCommand cxt nm = \case
liftIO $ SharedMsgId <$> encodedRandomBytes gVar 12
-- | Dispatch a resolved NameRecord by eagerly preparing a contact/group row
-- with @simplex_name@ set, then returning the same plan shape ('CAPKnown' /
-- 'GLPKnown') the local-store-hit branch of 'connectPlanName' returns. The
-- prepare-then-CAPKnown semantic threads the resolved name into persistence
-- via the existing 'createPreparedContact' / 'createPreparedGroup' simplex_name
-- parameter (introduced for the local-prepare path, see commit c6f26150), so
-- the resolver hit reuses the same DB write path as a local-prepare hit.
-- (the resolved link's embedded profile carries contact_domain / group_domain),
-- then returning the same plan shape ('CAPKnown' / 'GLPKnown') the
-- local-store-hit branch of 'connectPlanName' returns, so the resolver hit
-- reuses the same DB write path as a local-prepare hit.
dispatchResolvedRecord :: StoreCxt -> NetworkRequestMode -> User -> SimplexNameInfo -> NameRecord -> CM (ACreatedConnLink, ConnectionPlan)
dispatchResolvedRecord cxt nm user ni@SimplexNameInfo {nameType} NameRecord {nrSimplexChannel, nrSimplexContact} = do
lnk <- liftEither $ firstNameLink nameType nrSimplexChannel nrSimplexContact ni
@@ -4741,7 +4739,7 @@ dispatchResolvedRecord cxt nm user ni@SimplexNameInfo {nameType} NameRecord {nrS
liftIO (decodeLinkUserData cData) >>= maybe (throwError $ chatErrorAgent $ AGENT $ A_LINK "could not decode contact profile from RSLV link") pure
let ccLink = CCLink cReq (Just l')
accLink = ACCL SCMContact ccLink
ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink Nothing (Just ni)
ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink Nothing
pure (accLink, CPContactAddress (CAPKnown ct))
prepareGroup :: ConnShortLink 'CMContact -> CM (ACreatedConnLink, ConnectionPlan)
prepareGroup l = do
@@ -4754,7 +4752,7 @@ dispatchResolvedRecord cxt nm user ni@SimplexNameInfo {nameType} NameRecord {nrS
subRole <- if useRelays then asks $ channelSubscriberRole . config else pure GRMember
gVar <- asks random
let ccLink = CCLink cReq (Just l')
(g, _hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user groupProfile False ccLink Nothing useRelays subRole publicMemberCount_ (Just ni)
(g, _hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user groupProfile False ccLink Nothing useRelays subRole publicMemberCount_
pure (ACCL SCMContact ccLink, CPGroupLink (GLPKnown g (BoolDef False) Nothing (ListDef [])))
-- Mirror the inline 'serverShortLink' helper defined in 'processChatCommand'
-- where this dispatch is invoked: RSLV-supplied short links may carry the
@@ -4800,9 +4798,9 @@ linksMatch resolved stored = case strDecode (encodeUtf8 resolved) :: Either Stri
CLShort (CSLContact _ ct srv linkKey) ->
strEncode (CSLContact SLSServer ct srv linkKey :: ConnShortLink 'CMContact)
-- | Resolves the chat row's simplex_name claim via RSLV (the agent picks a
-- names server) and compares the resolved per-type link to the peer's stored
-- connection link. On match, timestamps the contact/group row. Returns
-- | Resolves the chat row's name claim via RSLV (the agent picks a names
-- server) and compares the resolved per-type link to the peer's stored
-- connection link. Persists the 3-state verification result. Returns
-- CRSimplexNameVerified with the boolean result (mirrors CRConnectionVerified);
-- resolver / agent failures propagate as the usual ChatErrorAgent.
-- Throws a command error when the row has no claim to verify.
@@ -4821,30 +4819,29 @@ apiVerifySimplexName user nm chatRef = do
-- The peer's stored link verifies if it matches ANY advertised link
-- (primary or fallback); an empty list never matches.
verified = any (`linksMatch` storedLink) resolvedLinks
when verified $ do
ts <- liftIO getCurrentTime
withStore' $ \db -> persistVerified db ts
withStore' $ \db -> persistVerified db verified
pure $ CRSimplexNameVerified user chatRef claim verified
where
-- Returns the claim to verify, the peer's stored link, and a callback that
-- persists the verified_at timestamp to the appropriate table. Throws a
-- persists the 3-state verification result to the appropriate table. Throws a
-- command error when the row has no claim or no link (nothing to verify).
loadClaimAndLink :: StoreCxt -> CM (SimplexNameInfo, ConnLinkContact, DB.Connection -> UTCTime -> IO ())
loadClaimAndLink :: StoreCxt -> CM (SimplexNameInfo, ConnLinkContact, DB.Connection -> Bool -> IO ())
loadClaimAndLink cxt = case chatRef of
ChatRef CTDirect cId _ -> do
ct <- withFastStore $ \db -> getContact db cxt user cId
let Contact {contactId, simplexName = ctSimplexName, profile = LocalProfile {contactLink}} = ct
claim <- maybe (throwCmdError "contact has no simplex_name to verify") pure ctSimplexName
let Contact {contactId, profile = LocalProfile {contactLink, contactDomain}} = ct
claim <- maybe (throwCmdError "contact has no name to verify") pure contactDomain
lnk <- maybe (throwCmdError "contact has no stored link to verify against") pure contactLink
pure (claim, lnk, \db ts -> setContactSimplexNameVerifiedAt db user contactId ts)
pure (claim, lnk, \db verified -> setContactDomainVerified db user contactId verified)
ChatRef CTGroup gId _ -> do
g <- withFastStore $ \db -> getGroupInfo db cxt user gId
let GroupInfo {groupId, simplexName = gSimplexName, preparedGroup} = g
claim <- maybe (throwCmdError "group has no simplex_name to verify") pure gSimplexName
let GroupInfo {groupId, groupProfile = GroupProfile {publicGroup}, preparedGroup} = g
gName = (\(StrJSON n) -> n) <$> (publicGroup >>= publicGroupAccess >>= groupDomain)
claim <- maybe (throwCmdError "group has no name to verify") pure gName
PreparedGroup {connLinkToConnect = CCLink cReq shortLink_} <-
maybe (throwCmdError "group has no stored link to verify against") pure preparedGroup
let lnk = maybe (CLFull cReq) CLShort shortLink_
pure (claim, lnk, \db ts -> setGroupSimplexNameVerifiedAt db user groupId ts)
pure (claim, lnk, \db verified -> setGroupDomainVerified db user groupId verified)
_ -> throwCmdError "APIVerifySimplexName supports only direct and group chat refs"
data ConnectViaContactResult
@@ -5668,7 +5665,7 @@ chatCommandP =
onOffP = ("on" $> True) <|> ("off" $> False)
publicGroupAccessP = do
groupWebPage <- optional (" web=" *> (safeDecodeUtf8 <$> A.takeTill A.isSpace))
groupDomain <- optional (" domain=" *> (safeDecodeUtf8 <$> A.takeTill A.isSpace))
groupDomain <- optional (" domain=" *> (StrJSON <$> strP))
domainWebPage <- (" domain_page=" *> onOffP) <|> pure False
allowEmbedding <- (" embed=" *> onOffP) <|> pure False
pure PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding}
@@ -5692,7 +5689,7 @@ chatCommandP =
newUserP relay = do
(cName, shortDescr) <- profileNameDescr
service <- (" service=" *> onOffP) <|> pure False
let profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, simplexName = Nothing}
let profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
pure NewUser {profile, pastTimestamp = False, userChatRelay = BoolDef relay, clientService = BoolDef service}
newBotUserP = do
files_ <- optional $ "files=" *> onOffP <* A.space
@@ -5701,7 +5698,7 @@ chatCommandP =
let preferences = case files_ of
Just True -> Nothing
_ -> Just (emptyChatPrefs :: Preferences) {files = Just FilesPreference {allow = FANo}}
profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences, badge = Nothing, simplexName = Nothing}
profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences, badge = Nothing, contactDomain = Nothing}
pure NewUser {profile, pastTimestamp = False, userChatRelay = BoolDef False, clientService = BoolDef service}
jsonP :: J.FromJSON a => Parser a
jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
@@ -5713,7 +5710,7 @@ chatCommandP =
{ directMessages = Just DirectMessagesGroupPreference {enable = FEOn, role = Nothing},
history = Just HistoryGroupPreference {enable = FEOn}
}
pure GroupProfile {displayName = gName, fullName = "", shortDescr, description = Nothing, image = Nothing, publicGroup = Nothing, simplexName = Nothing, groupPreferences, memberAdmission = Nothing}
pure GroupProfile {displayName = gName, fullName = "", shortDescr, description = Nothing, image = Nothing, publicGroup = Nothing, groupPreferences, memberAdmission = Nothing}
channelProfile = do
p@GroupProfile {groupPreferences = prefs_} <- groupProfile
let prefs = (fromMaybe emptyGroupPrefs prefs_) {support = Just SupportGroupPreference {enable = FEOff}} :: GroupPreferences
src/Simplex/Chat/Library/Internal.hs
+6 -6
View File
File diff suppressed because one or more lines are too long
src/Simplex/Chat/Library/Subscriber.hs
+1 -6
View File
@@ -3055,12 +3055,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
conn' <- updatePeerChatVRange activeConn chatVRange
case chatMsgEvent of
XInfo p -> do
-- Consume the transient simplex_name carrier from the connection row
-- (set in createConnection_ on the connect-via-plan path) and pass it
-- to createDirectContact; after this point contacts.simplex_name is
-- the source of truth.
let Connection {simplexName} = conn'
ct <- withStore $ \db -> createDirectContact db cxt user conn' p simplexName
ct <- withStore $ \db -> createDirectContact db cxt user conn' p
toView $ CEvtContactConnecting user ct
pure (conn', Nothing)
XGrpLinkInv glInv -> do
src/Simplex/Chat/ProfileGenerator.hs
+1 -1
View File
@@ -10,7 +10,7 @@ generateRandomProfile :: IO Profile
generateRandomProfile = do
adjective <- pick adjectives
noun <- pickNoun adjective 2
pure $ Profile {displayName = adjective <> noun, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, simplexName = Nothing}
pure $ Profile {displayName = adjective <> noun, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
where
pick :: [a] -> IO a
pick xs = (xs !!) <$> randomRIO (0, length xs - 1)
src/Simplex/Chat/Store/Connections.hs
+8 -9
View File
@@ -98,7 +98,7 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, xcontact_id, custom_user_profile_id,
conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, user_contact_link_id,
created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter, quota_err_counter,
conn_chat_version, peer_chat_min_version, peer_chat_max_version, simplex_name
conn_chat_version, peer_chat_min_version, peer_chat_max_version
FROM connections
WHERE user_id = ? AND agent_conn_id = ? AND conn_status != ?
|]
@@ -117,22 +117,21 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
c.contact_group_member_id, c.contact_grp_inv_sent, c.grp_direct_inv_link, c.grp_direct_inv_from_group_id, c.grp_direct_inv_from_group_member_id, c.grp_direct_inv_from_member_conn_id, c.grp_direct_inv_started_connection,
c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx,
c.simplex_name, p.simplex_name, c.simplex_name_verified_at
p.contact_domain, p.contact_domain_verification
FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
WHERE c.user_id = ? AND c.contact_id = ? AND c.contact_status = ? AND c.deleted = 0
|]
(userId, contactId, CSActive)
toContact' :: UTCTime -> Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
toContact' currentTs contactId conn chatTags ((profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow :. (ctSimplexNameRaw, cpSimplexNameRaw, simplexNameVerifiedAt)) =
let simplexName = decodeSimplexName ctSimplexNameRaw
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = decodeSimplexName cpSimplexNameRaw, peerType, localBadge = rowToBadge currentTs badgeRow, preferences, localAlias}
toContact' currentTs contactId conn chatTags ((profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow :. (cpContactDomain, cpContactDomainVerification)) =
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = cpContactDomain, contactDomainVerification = unBI <$> cpContactDomainVerification, peerType, localBadge = rowToBadge currentTs badgeRow, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
activeConn = Just conn
preparedContact = toPreparedContact preparedContactRow
groupDirectInv = toGroupDirectInvitation groupDirectInvRow
in Contact {contactId, localDisplayName, profile, activeConn, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, preparedContact, contactRequestId, contactGroupMemberId, contactGrpInvSent, groupDirectInv, chatTags, chatItemTTL, uiThemes, chatDeleted, customData, simplexName, simplexNameVerifiedAt}
in Contact {contactId, localDisplayName, profile, activeConn, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, preparedContact, contactRequestId, contactGroupMemberId, contactGrpInvSent, groupDirectInv, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ groupMemberId c = do
currentTs <- liftIO getCurrentTime
@@ -154,19 +153,19 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
g.use_relays, g.relay_own_status,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.roster_version, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.root_priv_key, g.root_pub_key, g.member_priv_key,
g.simplex_name, gp.simplex_name, g.simplex_name_verified_at,
g.group_domain_verification,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.index_in_group, 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, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra, pu.badge_master_key, pu.badge_signature, pu.badge_key_idx, pu.simplex_name,
pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra, pu.badge_master_key, pu.badge_signature, pu.badge_key_idx, pu.contact_domain, pu.contact_domain_verification,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts, mu.member_pub_key, mu.relay_link,
-- from GroupMember
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.simplex_name,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_verification,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link
FROM group_members m
src/Simplex/Chat/Store/ContactRequest.hs
+3 -3
View File
@@ -116,11 +116,11 @@ createOrUpdateContactRequest
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.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra, cp.badge_master_key, cp.badge_signature, cp.badge_key_idx, ct.simplex_name, cp.simplex_name, ct.simplex_name_verified_at,
cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra, cp.badge_master_key, cp.badge_signature, cp.badge_key_idx, cp.contact_domain, cp.contact_domain_verification,
-- 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.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, c.simplex_name
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
LEFT JOIN connections c ON c.contact_id = ct.contact_id
@@ -152,7 +152,7 @@ createOrUpdateContactRequest
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.simplex_name
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_verification
FROM contact_requests cr
JOIN contact_profiles p USING (contact_profile_id)
WHERE cr.user_id = ?
src/Simplex/Chat/Store/Direct.hs
+57 -63
View File
@@ -17,7 +17,6 @@ module Simplex.Chat.Store.Direct
( updateContactLDN_,
updateContactProfile_,
updateContactProfile_',
clearConflictingContactProfileSimplexName_,
updateMemberContactProfileReset_',
updateMemberContactProfileReset_,
updateMemberContactProfile_,
@@ -53,7 +52,7 @@ module Simplex.Chat.Store.Direct
getContactIdByName,
getContactIdBySimplexName,
updateContactProfile,
setContactSimplexNameVerifiedAt,
setContactDomainVerified,
updateContactUserPreferences,
updateContactAlias,
updateContactConnectionAlias,
@@ -116,6 +115,7 @@ import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionModeI (..), ConnectionRequestUri, CreatedConnLink (..), SimplexNameInfo, UserId)
import Simplex.Messaging.Encoding.String (StrJSON (..))
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -219,8 +219,7 @@ createConnReqConnection db userId acId preparedEntity_ cReq cReqHash sLnk xConta
pqRcvEnabled = Nothing,
authErrCounter = 0,
quotaErrCounter = 0,
createdAt = currentTs,
simplexName = Nothing
createdAt = currentTs
}
where
(connType, contactId_, groupMemberId_, entityId) = case preparedEntity_ of
@@ -303,7 +302,7 @@ getConnReqContactXContactId db cxt user@User {userId} cReqHash1 cReqHash2 =
[sql|
SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, xcontact_id, custom_user_profile_id, conn_status, conn_type, contact_conn_initiated, local_alias,
contact_id, group_member_id, user_contact_link_id, created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter, quota_err_counter,
conn_chat_version, peer_chat_min_version, peer_chat_max_version, simplex_name
conn_chat_version, peer_chat_min_version, peer_chat_max_version
FROM connections
WHERE (user_id = ? AND via_contact_uri_hash = ?)
OR (user_id = ? AND via_contact_uri_hash = ?)
@@ -326,11 +325,11 @@ getContactByConnReqHash db cxt user@User {userId} cReqHash1 cReqHash2 = do
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra, cp.badge_master_key, cp.badge_signature, cp.badge_key_idx,
ct.simplex_name, cp.simplex_name, ct.simplex_name_verified_at,
cp.contact_domain, cp.contact_domain_verification,
-- 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.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, c.simplex_name
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
JOIN connections c ON c.contact_id = ct.contact_id
@@ -371,8 +370,7 @@ createDirectConnection' db userId acId ccLink contactId_ connStatus incognitoPro
pqRcvEnabled = Nothing,
authErrCounter = 0,
quotaErrCounter = 0,
createdAt,
simplexName = Nothing
createdAt
}
createDirectConnection :: DB.Connection -> User -> ConnId -> CreatedLinkInvitation -> Maybe ContactId -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
@@ -404,12 +402,12 @@ createIncognitoProfile db User {userId} p = do
createdAt <- getCurrentTime
createIncognitoProfile_ db userId createdAt p
createPreparedContact :: DB.Connection -> StoreCxt -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> Maybe SimplexNameInfo -> ExceptT StoreError IO Contact
createPreparedContact db cxt user p connLinkToConnect welcomeSharedMsgId simplexName = do
createPreparedContact :: DB.Connection -> StoreCxt -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact
createPreparedContact db cxt user p connLinkToConnect welcomeSharedMsgId = do
currentTs <- liftIO getCurrentTime
let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
ctUserPreferences = newContactUserPrefs user p
contactId <- createContact_ db cxt user p ctUserPreferences prepared "" currentTs simplexName
contactId <- createContact_ db cxt user p ctUserPreferences prepared "" currentTs
getContact db cxt user contactId
updatePreparedContactUser :: DB.Connection -> StoreCxt -> User -> Contact -> User -> ExceptT StoreError IO Contact
@@ -450,11 +448,11 @@ updatePreparedContactUser
safeDeleteLDN db user oldLDN
getContact db cxt newUser contactId
createDirectContact :: DB.Connection -> StoreCxt -> User -> Connection -> Profile -> Maybe SimplexNameInfo -> ExceptT StoreError IO Contact
createDirectContact db cxt user Connection {connId, localAlias} p simplexName = do
createDirectContact :: DB.Connection -> StoreCxt -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
createDirectContact db cxt user Connection {connId, localAlias} p = do
currentTs <- liftIO getCurrentTime
let ctUserPreferences = newContactUserPrefs user p
contactId <- createContact_ db cxt user p ctUserPreferences Nothing localAlias currentTs simplexName
contactId <- createContact_ db cxt user p ctUserPreferences Nothing localAlias currentTs
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
getContact db cxt user contactId
@@ -562,52 +560,49 @@ deleteUnusedProfile_ db userId profileId =
:. (userId, profileId, userId, profileId, profileId)
)
-- | Updates the contact profile, also clearing the simplex_name on any other
-- contact_profiles row in the same user that already holds the same
-- (user_id, simplex_name) — newer-claim-wins, required by the partial UNIQUE
-- index.
--
-- Also clears contacts.simplex_name_verified_at when the peer's simplex_name
-- claim changes (any value transition, including Nothing<->Just): the prior
-- verification was tied to the prior claim and must be re-issued by the user.
-- | Updates the contact profile, writing the peer's contact_domain claim onto
-- the profile. Resets contact_domain_verification to NULL only when the claimed
-- name changes (the prior verification was tied to the prior claim); an XInfo
-- carrying the same name keeps the existing status, exactly as a badge does. No
-- conflict clearing (no UNIQUE index).
updateContactProfile :: DB.Connection -> StoreCxt -> User -> Contact -> Profile -> ExceptT StoreError IO Contact
updateContactProfile db cxt user@User {userId} c p' = do
currentTs <- liftIO getCurrentTime
badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) lp p'
let profile = toLocalProfile profileId p' localAlias currentTs badgeVerified
let nameVerified = if claimChanged then Nothing else prevVerification
profile = toLocalProfile profileId p' localAlias currentTs badgeVerified nameVerified
updateContactProfile' currentTs badgeVerified profile
where
Contact {contactId, localDisplayName, profile = lp@LocalProfile {profileId, displayName, localAlias, simplexName = prevClaim}, userPreferences} = c
Profile {displayName = newName, simplexName = profileSimplexName, preferences} = p'
Contact {contactId, localDisplayName, profile = lp@LocalProfile {profileId, displayName, localAlias, contactDomain = prevClaim, contactDomainVerification = prevVerification}, userPreferences} = c
Profile {displayName = newName, contactDomain = profileContactDomain, preferences} = p'
mergedPreferences = contactUserPreferences user userPreferences preferences $ contactConnIncognito c
claimChanged = prevClaim /= profileSimplexName
c' = if claimChanged then (c :: Contact) {simplexNameVerifiedAt = Nothing} else c
clearVerifiedAtIfClaimChanged =
claimChanged = prevClaim /= ((\(StrJSON n) -> n) <$> profileContactDomain)
clearVerificationIfClaimChanged =
when claimChanged $
DB.execute db "UPDATE contacts SET simplex_name_verified_at = NULL WHERE user_id = ? AND contact_id = ?" (userId, contactId)
DB.execute db "UPDATE contact_profiles SET contact_domain_verification = NULL WHERE user_id = ? AND contact_profile_id = ?" (userId, profileId)
updateContactProfile' currentTs badgeVerified profile
| displayName == newName = do
liftIO $ clearConflictingContactProfileSimplexName_ db userId (Just profileId) profileSimplexName
liftIO $ updateContactProfile_' db userId profileId p' badgeVerified currentTs
liftIO clearVerifiedAtIfClaimChanged
pure c' {profile, mergedPreferences}
liftIO clearVerificationIfClaimChanged
pure c {profile, mergedPreferences}
| otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
clearConflictingContactProfileSimplexName_ db userId (Just profileId) profileSimplexName
updateContactProfile_' db userId profileId p' badgeVerified currentTs
updateContactLDN_ db user contactId localDisplayName ldn currentTs
clearVerifiedAtIfClaimChanged
pure $ Right c' {localDisplayName = ldn, profile, mergedPreferences}
clearVerificationIfClaimChanged
pure $ Right c {localDisplayName = ldn, profile, mergedPreferences}
-- | Records that the user successfully RSLV-verified the peer's simplex_name
-- claim against the contact's stored connection link. Cleared back to NULL by
-- updateContactProfile whenever the peer's claim transitions.
setContactSimplexNameVerifiedAt :: DB.Connection -> User -> ContactId -> UTCTime -> IO ()
setContactSimplexNameVerifiedAt db User {userId} contactId ts =
-- | Records the local 3-state verification status of the peer's name claim.
-- Cleared back to NULL by updateContactProfile when the claim changes.
setContactDomainVerified :: DB.Connection -> User -> ContactId -> Bool -> IO ()
setContactDomainVerified db User {userId} contactId verified =
DB.execute
db
"UPDATE contacts SET simplex_name_verified_at = ? WHERE user_id = ? AND contact_id = ?"
(ts, userId, contactId)
[sql|
UPDATE contact_profiles SET contact_domain_verification = ?
WHERE contact_profile_id IN (SELECT contact_profile_id FROM contacts WHERE user_id = ? AND contact_id = ?)
|]
(BI verified, userId, contactId)
updateContactUserPreferences :: DB.Connection -> User -> Contact -> Preferences -> IO Contact
updateContactUserPreferences db user@User {userId} c@Contact {contactId} userPreferences = do
@@ -740,17 +735,17 @@ updateContactProfile_ db userId profileId profile badgeVerified = do
updateContactProfile_' db userId profileId profile badgeVerified currentTs
updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, simplexName, preferences, peerType, badge} badgeVerified updatedAt =
updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain, preferences, peerType, badge} badgeVerified updatedAt =
DB.execute
db
[sql|
UPDATE contact_profiles
SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = ?, preferences = ?, chat_peer_type = ?, updated_at = ?,
badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?, badge_key_idx = ?,
simplex_name = ?
contact_domain = ?
WHERE user_id = ? AND contact_profile_id = ?
|]
((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. badgeToRow badge badgeVerified :. Only simplexName :. (userId, profileId))
((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. badgeToRow badge badgeVerified :. Only ((\(StrJSON n) -> n) <$> contactDomain) :. (userId, profileId))
-- update only member profile fields (when member doesn't have associated contact - we can reset contactLink and prefs)
updateMemberContactProfileReset_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO ()
@@ -759,17 +754,17 @@ updateMemberContactProfileReset_ db userId profileId profile badgeVerified = do
updateMemberContactProfileReset_' db userId profileId profile badgeVerified currentTs
updateMemberContactProfileReset_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, image, simplexName, badge} badgeVerified updatedAt =
updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactDomain, badge} badgeVerified updatedAt =
DB.execute
db
[sql|
UPDATE contact_profiles
SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = NULL, preferences = NULL, updated_at = ?,
badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?, badge_key_idx = ?,
simplex_name = ?
contact_domain = ?
WHERE user_id = ? AND contact_profile_id = ?
|]
((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. Only simplexName :. (userId, profileId))
((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. Only ((\(StrJSON n) -> n) <$> contactDomain) :. (userId, profileId))
-- update only member profile fields (when member has associated contact - we keep contactLink and prefs)
updateMemberContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO ()
@@ -778,17 +773,17 @@ updateMemberContactProfile_ db userId profileId profile badgeVerified = do
updateMemberContactProfile_' db userId profileId profile badgeVerified currentTs
updateMemberContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, simplexName, badge} badgeVerified updatedAt =
updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactDomain, badge} badgeVerified updatedAt =
DB.execute
db
[sql|
UPDATE contact_profiles
SET display_name = ?, full_name = ?, short_descr = ?, image = ?, updated_at = ?,
badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?, badge_key_idx = ?,
simplex_name = ?
contact_domain = ?
WHERE user_id = ? AND contact_profile_id = ?
|]
((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. Only simplexName :. (userId, profileId))
((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. Only ((\(StrJSON n) -> n) <$> contactDomain) :. (userId, profileId))
updateContactLDN_ :: DB.Connection -> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt = do
@@ -819,8 +814,9 @@ getContactIdBySimplexName db User {userId} ni =
DB.query
db
[sql|
SELECT contact_id FROM contacts
WHERE user_id = ? AND simplex_name = ? AND deleted = 0
SELECT ct.contact_id FROM contacts ct
JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
WHERE ct.user_id = ? AND cp.contact_domain = ? AND cp.contact_domain_verification = 1 AND ct.deleted = 0
|]
(userId, ni)
@@ -864,7 +860,7 @@ contactRequestQuery =
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx,
p.simplex_name
p.contact_domain, p.contact_domain_verification
FROM contact_requests cr
JOIN contact_profiles p USING (contact_profile_id)
|]
@@ -935,9 +931,7 @@ createContactFromRequest db user@User {userId, profile = LocalProfile {preferenc
chatItemTTL = Nothing,
uiThemes = Nothing,
chatDeleted = False,
customData = Nothing,
simplexName = Nothing,
simplexNameVerifiedAt = Nothing
customData = Nothing
}
pure (ct, conn)
@@ -946,7 +940,7 @@ createAcceptedContactConn db User {userId} uclId_ contactId agentConnId connChat
customUserProfileId <- forM incognitoProfile $ \case
NewIncognito p -> createIncognitoProfile_ db userId currentTs p
ExistingIncognito LocalProfile {profileId = pId} -> pure pId
createConnection_ db userId ConnContact (Just contactId) agentConnId ConnNew connChatVersion cReqChatVRange Nothing uclId_ customUserProfileId 0 currentTs subMode pqSup Nothing
createConnection_ db userId ConnContact (Just contactId) agentConnId ConnNew connChatVersion cReqChatVRange Nothing uclId_ customUserProfileId 0 currentTs subMode pqSup
updateContactAccepted :: DB.Connection -> User -> Contact -> Bool -> IO ()
updateContactAccepted db User {userId} Contact {contactId} contactUsed =
@@ -987,11 +981,11 @@ getContact_ db cxt user@User {userId} contactId deleted = do
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra, cp.badge_master_key, cp.badge_signature, cp.badge_key_idx,
ct.simplex_name, cp.simplex_name, ct.simplex_name_verified_at,
cp.contact_domain, cp.contact_domain_verification,
-- 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.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, c.simplex_name
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
LEFT JOIN connections c ON c.contact_id = ct.contact_id
@@ -1017,7 +1011,7 @@ getContactConnections db cxt userId Contact {contactId} =
SELECT 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.xcontact_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, c.simplex_name
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM connections c
JOIN contacts ct ON ct.contact_id = c.contact_id
WHERE c.user_id = ? AND ct.user_id = ? AND ct.contact_id = ?
@@ -1035,7 +1029,7 @@ getConnectionById db cxt User {userId} connId = ExceptT $ do
SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, xcontact_id, custom_user_profile_id,
conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, user_contact_link_id,
created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter, quota_err_counter,
conn_chat_version, peer_chat_min_version, peer_chat_max_version, simplex_name
conn_chat_version, peer_chat_min_version, peer_chat_max_version
FROM connections
WHERE user_id = ? AND connection_id = ?
|]
src/Simplex/Chat/Store/Groups.hs
+64 -120
View File
@@ -46,8 +46,7 @@ module Simplex.Chat.Store.Groups
getGroupViaShortLinkToConnect,
getGroupInfoByGroupLinkHash,
updateGroupProfile,
setGroupSimplexNameVerifiedAt,
clearConflictingGroupProfileSimplexName_,
setGroupDomainVerified,
updateGroupPreferences,
updateGroupProfileFromMember,
getGroupIdByName,
@@ -238,6 +237,7 @@ import Simplex.Messaging.Agent.Protocol (ConfirmationId, ConnId, CreatedConnLink
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, fromOnlyBI, maybeFirstRow)
import qualified Simplex.FileTransfer.Description as FD
import Simplex.Messaging.Encoding (smpDecode, smpEncode)
import Simplex.Messaging.Encoding.String (StrJSON (..))
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import Simplex.Messaging.Agent.Store.Entity (DBEntityId)
import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -255,11 +255,11 @@ import Database.SQLite.Simple (Only (..), Query, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif
type MaybeGroupMemberRow = (Maybe GroupMemberId, Maybe GroupId, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId) :. ((Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe LocalAlias, Maybe Preferences) :. BadgeRow :. Only (Maybe Text)) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact)
type MaybeGroupMemberRow = (Maybe GroupMemberId, Maybe GroupId, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId) :. ((Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe LocalAlias, Maybe Preferences) :. BadgeRow :. (Maybe SimplexNameInfo, Maybe BoolInt)) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact)
toMaybeGroupMember :: UTCTime -> Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember now userContactId ((Just groupMemberId, Just groupId, Just indexInGroup, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId) :. ((Just profileId, Just displayName, Just fullName, shortDescr, image, contactLink, peerType, Just localAlias, contactPreferences) :. badgeRow :. Only profileSimplexNameRaw) :. (Just createdAt, Just updatedAt) :. (supportChatTs, Just supportChatUnread, Just supportChatUnanswered, Just supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink)) =
Just $ toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. ((profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, contactPreferences) :. badgeRow :. Only profileSimplexNameRaw) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink))
toMaybeGroupMember now userContactId ((Just groupMemberId, Just groupId, Just indexInGroup, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId) :. ((Just profileId, Just displayName, Just fullName, shortDescr, image, contactLink, peerType, Just localAlias, contactPreferences) :. badgeRow :. (profileContactDomain, profileContactDomainVerification)) :. (Just createdAt, Just updatedAt) :. (supportChatTs, Just supportChatUnread, Just supportChatUnanswered, Just supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink)) =
Just $ toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. ((profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, contactPreferences) :. badgeRow :. (profileContactDomain, profileContactDomainVerification)) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink))
toMaybeGroupMember _ _ _ = Nothing
createGroupLink :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> ConnId -> CreatedLinkContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO GroupLink
@@ -274,7 +274,7 @@ createGroupLink db gVar user@User {userId} groupInfo@GroupInfo {groupId, localDi
"INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, short_link_contact, short_link_data_set, short_link_large_data_set, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)"
((userId, groupId, groupLinkId, groupLinkLDN, cReq, shortLink, slDataSet, slDataSet) :. (memberRole, BI True, currentTs, currentTs))
userContactLinkId <- insertedRowId db
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode PQSupportOff Nothing
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode PQSupportOff
getGroupLink db user groupInfo
getGroupLinkConnection :: DB.Connection -> StoreCxt -> User -> GroupInfo -> ExceptT StoreError IO Connection
@@ -286,7 +286,7 @@ getGroupLinkConnection db cxt User {userId} groupInfo@GroupInfo {groupId} =
SELECT 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.xcontact_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, c.simplex_name
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM connections c
JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
WHERE c.user_id = ? AND uc.user_id = ? AND uc.group_id = ?
@@ -448,8 +448,7 @@ createNewGroup db cxt user@User {userId} groupProfile incognitoProfile useRelays
membersRequireAttention = 0,
viaGroupLinkUri = Nothing,
groupKeys,
simplexName = Nothing,
simplexNameVerifiedAt = Nothing
groupDomainVerification = Nothing
}
-- | creates a new group record for the group the current user was invited to, or returns an existing one
@@ -528,8 +527,7 @@ createGroupInvitation db cxt user@User {userId} contact@Contact {contactId, acti
membersRequireAttention = 0,
viaGroupLinkUri = Nothing,
groupKeys = Nothing,
simplexName = Nothing,
simplexNameVerifiedAt = Nothing
groupDomainVerification = Nothing
},
groupMemberId
)
@@ -645,11 +643,11 @@ 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 -> TVar ChaChaDRG -> StoreCxt -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> Maybe SimplexNameInfo -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember)
createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ simplexName = do
createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> StoreCxt -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember)
createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ = do
currentTs <- liftIO getCurrentTime
let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
(groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing useRelays Nothing publicMemberCount_ currentTs simplexName
(groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing useRelays Nothing publicMemberCount_ currentTs
hostMemberId_ <-
if useRelays
then pure Nothing
@@ -866,7 +864,7 @@ createGroupViaLink'
business
membershipStatus = do
currentTs <- liftIO getCurrentTime
(groupId, _groupLDN) <- createGroup_ db userId groupProfile Nothing business False Nothing Nothing currentTs Nothing
(groupId, _groupLDN) <- createGroup_ db userId groupProfile Nothing business False Nothing Nothing 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
@@ -893,8 +891,8 @@ createGroupViaLink'
)
insertedRowId db
createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe (CreatedLinkContact, Maybe SharedMsgId) -> Maybe BusinessChatInfo -> Bool -> Maybe RelayStatus -> Maybe Int64 -> UTCTime -> Maybe SimplexNameInfo -> ExceptT StoreError IO (GroupId, Text)
createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus publicMemberCount_ currentTs simplexName = ExceptT $ do
createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe (CreatedLinkContact, Maybe SharedMsgId) -> Maybe BusinessChatInfo -> Bool -> Maybe RelayStatus -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (GroupId, Text)
createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus publicMemberCount_ currentTs = ExceptT $ do
let GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission} = groupProfile
(groupType_, groupLink_, publicGroupId_) = case publicGroup of
Just PublicGroupProfile {groupType, groupLink, publicGroupId} -> (Just groupType, Just groupLink, Just publicGroupId)
@@ -920,10 +918,10 @@ createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus p
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, welcome_shared_msg_id,
business_chat, business_member_id, customer_member_id, use_relays, relay_own_status, public_member_count, simplex_name)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
business_chat, business_member_id, customer_member_id, use_relays, relay_own_status, public_member_count)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. toPreparedGroupRow prepared :. businessChatInfoRow business :. (BI useRelays, relayOwnStatus, publicMemberCount_, simplexName))
((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. toPreparedGroupRow prepared :. businessChatInfoRow business :. (BI useRelays, relayOwnStatus, publicMemberCount_))
groupId <- insertedRowId db
pure (groupId, localDisplayName)
@@ -1082,25 +1080,20 @@ getGroupInfoBySimplexName db cxt user ni =
Nothing -> pure Nothing
Just gId -> Just <$> getGroupInfo db cxt user gId
-- | Unlike the parallel 'getContactBySimplexName' lookup (which filters
-- @ct.deleted = 0@ to match the @idx_contacts_simplex_name@ partial index),
-- this query has no soft-delete predicate. The @groups@ table has no
-- @deleted@ column: groups are hard-deleted by 'deleteGroup' (DELETE FROM
-- groups), so there is no row to skip here. The "user removed from group
-- but row retained" case (membership transitioned to
-- 'GSMemRemoved'/'GSMemLeft'/'GSMemGroupDeleted') is handled by the
-- 'memberRemoved' check in 'connectPlanName' / 'gPlan' (Commands.hs) before
-- this lookup result is used as a known-and-reconnectable plan; the index
-- collision only matters for 'createPreparedGroup' inserts, which the
-- 'memberRemoved' branch falls through to via 'resolveAndDispatch'. That
-- collision is currently possible but untriggered in practice; clearing
-- @groups.simplex_name@ on a membership-removed transition (analogous to
-- 'clearConflictingGroupProfileSimplexName_') is the right fix when it
-- becomes reachable.
-- | Channel lookup by the verified name (group_profiles.group_domain joined with
-- groups.group_domain_verification = 1); on a miss the caller falls through to
-- resolve-and-connect.
getGroupIdBySimplexName :: DB.Connection -> User -> SimplexNameInfo -> IO (Maybe GroupId)
getGroupIdBySimplexName db User {userId} ni =
maybeFirstRow fromOnly $
DB.query db "SELECT group_id FROM groups WHERE user_id = ? AND simplex_name = ?" (userId, ni)
DB.query
db
[sql|
SELECT g.group_id FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
WHERE g.user_id = ? AND gp.group_domain = ? AND g.group_domain_verification = 1
|]
(userId, ni)
getGroupMember :: DB.Connection -> StoreCxt -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMember db cxt user@User {userId} groupId groupMemberId = do
@@ -1841,11 +1834,10 @@ createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMemb
description = Nothing,
image = Nothing,
publicGroup = Nothing,
simplexName = Nothing,
groupPreferences = Nothing,
memberAdmission = Nothing
}
(groupId, _groupLDN) <- createGroup_ db userId placeholderProfile Nothing Nothing True (Just relayStatus) Nothing currentTs Nothing
(groupId, _groupLDN) <- createGroup_ db userId placeholderProfile Nothing Nothing True (Just relayStatus) Nothing currentTs
-- Store relay request data for recovery
liftIO $ setRelayRequestData_ groupId currentTs
ownerMemberId <- insertOwner_ currentTs groupId
@@ -2090,7 +2082,7 @@ createJoiningMemberConnection
groupMemberId
subMode = do
createdAt <- liftIO getCurrentTime
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV cReqChatVRange Nothing (Just uclId) Nothing 0 createdAt subMode PQSupportOff Nothing
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV cReqChatVRange Nothing (Just uclId) Nothing 0 createdAt subMode PQSupportOff
setCommandConnId db user cmdId connId
createBusinessRequestGroup :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> VersionRangeChat -> Profile -> Int64 -> Text -> GroupPreferences -> ExceptT StoreError IO (GroupInfo, GroupMember)
@@ -2467,7 +2459,7 @@ createNewMember_
invitedBy,
invitedByGroupMemberId = memInvitedByGroupMemberId,
localDisplayName,
memberProfile = toLocalProfile memberContactProfileId memberProfile "" createdAt badgeVerified,
memberProfile = toLocalProfile memberContactProfileId memberProfile "" createdAt badgeVerified Nothing,
memberContactId,
memberContactProfileId,
activeConn,
@@ -2619,7 +2611,7 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId =
Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId chatV mcvr viaContactId cLevel currentTs subMode
setCommandConnId db user groupCmdId groupConnId
forM_ directConnIds $ \(directCmdId, directAgentConnId) -> do
Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId ConnNew chatV mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode PQSupportOff Nothing
Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId ConnNew chatV mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode PQSupportOff
setCommandConnId db user directCmdId directConnId
contactId <- createMemberContact_ directConnId currentTs
updateMember_ contactId currentTs
@@ -2651,49 +2643,38 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId =
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection
createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange viaContact connLevel currentTs subMode =
createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV peerChatVRange viaContact Nothing Nothing connLevel currentTs subMode PQSupportOff Nothing
createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV peerChatVRange viaContact Nothing Nothing connLevel currentTs subMode PQSupportOff
-- | Updates the group profile, also clearing the simplex_name on any other
-- group_profiles row (for the same user) that already holds the same
-- (user_id, simplex_name) — newer-claim-wins, required by the partial UNIQUE index.
-- | Updates the group profile, writing the channel name onto group_profiles
-- (group_domain, via the public-access columns). Resets group_domain_verification
-- to NULL only when the name changes. No conflict clearing (no UNIQUE index).
updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, simplexName = prevClaim}} p'@GroupProfile {displayName = newName, fullName, shortDescr, description, image, publicGroup, simplexName, groupPreferences, memberAdmission}
updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, publicGroup = oldPublicGroup}} p'@GroupProfile {displayName = newName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission}
| displayName == newName = liftIO $ do
currentTs <- getCurrentTime
profileId_ <- getGroupProfileId_
clearConflictingGroupProfileSimplexName_ db userId profileId_ simplexName
updateGroupProfile_ currentTs
clearVerifiedAtIfClaimChanged
clearVerificationIfClaimChanged
pure $ (g' :: GroupInfo) {groupProfile = p', fullGroupPreferences}
| otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime
profileId_ <- getGroupProfileId_
clearConflictingGroupProfileSimplexName_ db userId profileId_ simplexName
updateGroupProfile_ currentTs
updateGroup_ ldn currentTs
clearVerifiedAtIfClaimChanged
clearVerificationIfClaimChanged
pure $ Right $ (g' :: GroupInfo) {localDisplayName = ldn, groupProfile = p', fullGroupPreferences}
where
fullGroupPreferences = mergeGroupPreferences groupPreferences
claimChanged = prevClaim /= simplexName
g' = if claimChanged then (g :: GroupInfo) {simplexNameVerifiedAt = Nothing} else g
-- Mirrors updateContactProfile: clear the verification when
-- the peer's claim transitions to/from/between values; prior verification
-- was bound to the prior claim.
clearVerifiedAtIfClaimChanged =
groupClaim pg = (\(StrJSON n) -> n) <$> (pg >>= publicGroupAccess >>= groupDomain)
claimChanged = groupClaim oldPublicGroup /= groupClaim publicGroup
g' = if claimChanged then (g :: GroupInfo) {groupDomainVerification = Nothing} else g
-- Reset the verification when the channel name changes; prior verification
-- was bound to the prior name.
clearVerificationIfClaimChanged =
when claimChanged $
DB.execute db "UPDATE groups SET simplex_name_verified_at = NULL WHERE user_id = ? AND group_id = ?" (userId, groupId)
DB.execute db "UPDATE groups SET group_domain_verification = NULL WHERE user_id = ? AND group_id = ?" (userId, groupId)
(groupType_, groupLink_) = case publicGroup of
Just PublicGroupProfile {groupType, groupLink} -> (Just groupType, Just groupLink)
Nothing -> (Nothing, Nothing)
-- groups.group_profile_id is ON DELETE SET NULL; treat the row as having
-- no profile to exclude (Nothing) when it has been nulled out, so the
-- conflict-clear sees every same-user row as a potential collision.
getGroupProfileId_ :: IO (Maybe ProfileId)
getGroupProfileId_ =
fmap (>>= fromOnly) . maybeFirstRow id $
DB.query db "SELECT group_profile_id FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId)
updateGroupProfile_ currentTs =
DB.execute
db
@@ -2702,7 +2683,6 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
SET display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?,
group_type = ?, group_link = ?,
group_web_page = ?, group_domain = ?, domain_web_page = ?, allow_embedding = ?,
simplex_name = ?,
preferences = ?, member_admission = ?, updated_at = ?
WHERE group_profile_id IN (
SELECT group_profile_id
@@ -2710,7 +2690,7 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
WHERE user_id = ? AND group_id = ?
)
|]
((newName, fullName, shortDescr, description, image, groupType_, groupLink_) :. publicGroupAccessRow publicGroup :. Only simplexName :. (groupPreferences, memberAdmission, currentTs, userId, groupId))
((newName, fullName, shortDescr, description, image, groupType_, groupLink_) :. publicGroupAccessRow publicGroup :. (groupPreferences, memberAdmission, currentTs, userId, groupId))
updateGroup_ ldn currentTs = do
DB.execute
db
@@ -2718,40 +2698,13 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
(ldn, currentTs, userId, groupId)
safeDeleteLDN db user localDisplayName
-- | Mirror of clearConflictingContactProfileSimplexName_ for group_profiles.
-- Pass the group_profile_id being updated to exclude self from the clear;
-- pass Nothing for the pre-INSERT case. The profileId is taken directly
-- (rather than derived from groupId via a NOT IN subquery) because
-- groups.group_profile_id is ON DELETE SET NULL, and NOT IN (NULL)
-- evaluates to UNKNOWN — which would silently no-op the clear.
clearConflictingGroupProfileSimplexName_ :: DB.Connection -> UserId -> Maybe ProfileId -> Maybe SimplexNameInfo -> IO ()
clearConflictingGroupProfileSimplexName_ _ _ _ Nothing = pure ()
clearConflictingGroupProfileSimplexName_ db userId Nothing (Just simplexName) =
-- | Records the local 3-state verification status of the channel name.
setGroupDomainVerified :: DB.Connection -> User -> GroupId -> Bool -> IO ()
setGroupDomainVerified db User {userId} groupId verified =
DB.execute
db
[sql|
UPDATE group_profiles
SET simplex_name = NULL
WHERE user_id = ? AND simplex_name = ?
|]
(userId, simplexName)
clearConflictingGroupProfileSimplexName_ db userId (Just profileId) (Just simplexName) =
DB.execute
db
[sql|
UPDATE group_profiles
SET simplex_name = NULL
WHERE user_id = ? AND simplex_name = ? AND group_profile_id <> ?
|]
(userId, simplexName, profileId)
-- | Mirror of setContactSimplexNameVerifiedAt for groups.
setGroupSimplexNameVerifiedAt :: DB.Connection -> User -> GroupId -> UTCTime -> IO ()
setGroupSimplexNameVerifiedAt db User {userId} groupId ts =
DB.execute
db
"UPDATE groups SET simplex_name_verified_at = ? WHERE user_id = ? AND group_id = ?"
(ts, userId, groupId)
"UPDATE groups SET group_domain_verification = ? WHERE user_id = ? AND group_id = ?"
(BI verified, userId, groupId)
updateGroupPreferences :: DB.Connection -> User -> GroupInfo -> GroupPreferences -> IO GroupInfo
updateGroupPreferences db User {userId} g@GroupInfo {groupId, groupProfile = p} ps = do
@@ -2786,15 +2739,15 @@ updateGroupProfileFromMember db user g@GroupInfo {groupId} Profile {displayName
SELECT gp.display_name, gp.full_name, gp.short_descr, gp.description, gp.image,
gp.group_type, gp.group_link, gp.public_group_id,
gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding,
gp.simplex_name, gp.preferences, gp.member_admission
gp.preferences, gp.member_admission
FROM group_profiles gp
JOIN groups g ON gp.group_profile_id = g.group_profile_id
WHERE g.group_id = ?
|]
(Only groupId)
toGroupProfile ((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (simplexNameRaw, groupPreferences, memberAdmission)) =
toGroupProfile ((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (groupPreferences, memberAdmission)) =
let publicGroupAccess = toPublicGroupAccess accessRow
in GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ publicGroupAccess, simplexName = decodeSimplexName simplexNameRaw, groupPreferences, memberAdmission}
in GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ publicGroupAccess, groupPreferences, memberAdmission}
getGroupInfoByUserContactLinkConnReq :: DB.Connection -> StoreCxt -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq db cxt user@User {userId} (cReqSchema1, cReqSchema2) = do
@@ -3236,11 +3189,10 @@ createMemberContact
pqSndEnabled = Nothing,
pqRcvEnabled = Nothing,
authErrCounter = 0,
quotaErrCounter = 0,
simplexName = Nothing
quotaErrCounter = 0
}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, preparedContact = Nothing, contactRequestId = Nothing, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, groupDirectInv = Nothing, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing, simplexName = Nothing, simplexNameVerifiedAt = Nothing}
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, preparedContact = Nothing, contactRequestId = Nothing, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, groupDirectInv = Nothing, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
getMemberContact :: DB.Connection -> StoreCxt -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact db cxt user contactId = do
@@ -3378,26 +3330,22 @@ setMemberContactStartedConnection db Contact {contactId} = do
"UPDATE contacts SET grp_direct_inv_started_connection = ?, updated_at = ? WHERE contact_id = ?"
(BI True, currentTs, contactId)
-- | Updates the member profile, also clearing the simplex_name on any other
-- contact_profiles row in the same user that already holds the same
-- (user_id, simplex_name) — newer-claim-wins, required by the partial UNIQUE index.
-- | Updates the member profile (the profile writer persists contact_domain).
updateMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
updateMemberProfile db cxt user@User {userId} m p' = do
currentTs <- liftIO getCurrentTime
badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) (memberProfile m) p'
let memberProfile = toLocalProfile profileId p' localAlias currentTs badgeVerified
let memberProfile = toLocalProfile profileId p' localAlias currentTs badgeVerified Nothing
updateMemberProfile' currentTs badgeVerified memberProfile
where
GroupMember {groupMemberId, localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
Profile {displayName = newName, simplexName = profileSimplexName} = p'
Profile {displayName = newName} = p'
updateMemberProfile' currentTs badgeVerified memberProfile
| displayName == newName = do
liftIO $ clearConflictingContactProfileSimplexName_ db userId (Just profileId) profileSimplexName
liftIO $ updateMemberContactProfileReset_' db userId profileId p' badgeVerified currentTs
pure m {memberProfile}
| otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
clearConflictingContactProfileSimplexName_ db userId (Just profileId) profileSimplexName
updateMemberContactProfileReset_' db userId profileId p' badgeVerified currentTs
DB.execute
db
@@ -3406,26 +3354,22 @@ updateMemberProfile db cxt user@User {userId} m p' = do
safeDeleteLDN db user localDisplayName
pure $ Right m {localDisplayName = ldn, memberProfile}
-- | Updates the member's contact profile, also clearing the simplex_name on any
-- other contact_profiles row in the same user that already holds the same
-- (user_id, simplex_name) — newer-claim-wins, required by the partial UNIQUE index.
-- | Updates the member's contact profile (the profile writer persists contact_domain).
updateContactMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
updateContactMemberProfile db cxt user@User {userId} m ct@Contact {contactId} p' = do
currentTs <- liftIO getCurrentTime
badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) (memberProfile m) p'
let profile = toLocalProfile profileId p' localAlias currentTs badgeVerified
let profile = toLocalProfile profileId p' localAlias currentTs badgeVerified Nothing
updateContactMemberProfile' currentTs badgeVerified profile
where
GroupMember {localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
Profile {displayName = newName, simplexName = profileSimplexName} = p'
Profile {displayName = newName} = p'
updateContactMemberProfile' currentTs badgeVerified profile
| displayName == newName = do
liftIO $ clearConflictingContactProfileSimplexName_ db userId (Just profileId) profileSimplexName
liftIO $ updateMemberContactProfile_' db userId profileId p' badgeVerified currentTs
pure (m {memberProfile = profile}, ct {profile} :: Contact)
| otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
clearConflictingContactProfileSimplexName_ db userId (Just profileId) profileSimplexName
updateMemberContactProfile_' db userId profileId p' badgeVerified currentTs
updateContactLDN_ db user contactId localDisplayName ldn currentTs
pure $ Right (m {localDisplayName = ldn, memberProfile = profile}, ct {localDisplayName = ldn, profile} :: Contact)
src/Simplex/Chat/Store/Messages.hs
+5 -5
View File
@@ -715,7 +715,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.simplex_name,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_verification,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link
FROM group_members m
@@ -1139,7 +1139,7 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = do
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.simplex_name
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_verification
FROM contact_requests cr
JOIN contact_profiles p ON p.contact_profile_id = cr.contact_profile_id
JOIN user_contact_links uc ON uc.user_contact_link_id = cr.user_contact_link_id
@@ -3070,7 +3070,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.simplex_name,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_verification,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link,
-- quoted ChatItem
@@ -3079,14 +3079,14 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
rm.group_member_id, rm.group_id, rm.index_in_group, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
rm.member_status, rm.show_messages, rm.member_restriction, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rp.display_name, rp.full_name, rp.short_descr, rp.image, rp.contact_link, rp.chat_peer_type, rp.local_alias, rp.preferences,
rp.badge_proof, rp.badge_pres_header, rp.badge_expiry, rp.badge_type, rp.badge_verified, rp.badge_extra, rp.badge_master_key, rp.badge_signature, rp.badge_key_idx, rp.simplex_name,
rp.badge_proof, rp.badge_pres_header, rp.badge_expiry, rp.badge_type, rp.badge_verified, rp.badge_extra, rp.badge_master_key, rp.badge_signature, rp.badge_key_idx, rp.contact_domain, rp.contact_domain_verification,
rm.created_at, rm.updated_at,
rm.support_chat_ts, rm.support_chat_items_unread, rm.support_chat_items_member_attention, rm.support_chat_items_mentions, rm.support_chat_last_msg_from_member_ts, rm.member_pub_key, rm.relay_link,
-- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.index_in_group, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbp.display_name, dbp.full_name, dbp.short_descr, dbp.image, dbp.contact_link, dbp.chat_peer_type, dbp.local_alias, dbp.preferences,
dbp.badge_proof, dbp.badge_pres_header, dbp.badge_expiry, dbp.badge_type, dbp.badge_verified, dbp.badge_extra, dbp.badge_master_key, dbp.badge_signature, dbp.badge_key_idx, dbp.simplex_name,
dbp.badge_proof, dbp.badge_pres_header, dbp.badge_expiry, dbp.badge_type, dbp.badge_verified, dbp.badge_extra, dbp.badge_master_key, dbp.badge_signature, dbp.badge_key_idx, dbp.contact_domain, dbp.contact_domain_verification,
dbm.created_at, dbm.updated_at,
dbm.support_chat_ts, dbm.support_chat_items_unread, dbm.support_chat_items_member_attention, dbm.support_chat_items_mentions, dbm.support_chat_last_msg_from_member_ts, dbm.member_pub_key, dbm.relay_link
FROM chat_items i
src/Simplex/Chat/Store/Postgres/Migrations/M20260603_simplex_name.hs
+13 -56
View File
@@ -6,56 +6,23 @@ module Simplex.Chat.Store.Postgres.Migrations.M20260603_simplex_name where
import Data.Text (Text)
import Text.RawString.QQ (r)
-- contacts.simplex_name and groups.simplex_name are the source of truth for the
-- entity's current name (updated when XInfo/XGrpInfo arrives).
-- The entity name lives only on the profile: contact_profiles.contact_domain holds
-- the peer's broadcast contact name, and the existing group_profiles.group_domain
-- (from M20260515) holds the channel name. Both store the canonical strEncode form
-- as TEXT.
--
-- connections.simplex_name is a TRANSIENT carrier for the connect-via-plan
-- (connect-by-name) path: when the user initiates a connection by typing
-- #name.simplex, the peer's profile is not yet available, so the name is
-- stashed on the connection row. When XInfo arrives and the Contact row is
-- created, the XInfo handler in Library/Subscriber.hs reads
-- connections.simplex_name and passes it to createDirectContact. After contact
-- creation, contacts.simplex_name is canonical and the connection's value
-- becomes a historical snapshot - it is intentionally never UPDATEd.
--
-- contact_profiles.simplex_name and group_profiles.simplex_name hold the peer's
-- broadcast claim (received via XInfo/XGrpInfo).
--
-- contacts.simplex_name_verified_at and groups.simplex_name_verified_at record
-- when the user last verified (via RSLV) that the peer's claimed simplex_name
-- resolves to the link stored locally. NULL means unverified; it is cleared
-- back to NULL whenever the claim changes (updateContactProfile / updateGroupProfile).
-- contact_profiles.contact_domain_verification and groups.group_domain_verification
-- are the local 3-state verification status (NULL = not attempted, 0 = failed,
-- 1 = verified), reset to NULL when the claimed name changes.
--
-- server_operators.smp_role_names enables name resolution for an operator's SMP
-- servers (set for the simplex operator).
m20260603_simplex_name :: Text
m20260603_simplex_name =
[r|
ALTER TABLE contacts ADD COLUMN simplex_name TEXT;
ALTER TABLE groups ADD COLUMN simplex_name TEXT;
ALTER TABLE connections ADD COLUMN simplex_name TEXT;
CREATE UNIQUE INDEX idx_contacts_simplex_name
ON contacts(user_id, simplex_name)
WHERE simplex_name IS NOT NULL AND deleted = 0;
CREATE UNIQUE INDEX idx_groups_simplex_name
ON groups(user_id, simplex_name)
WHERE simplex_name IS NOT NULL;
ALTER TABLE contact_profiles ADD COLUMN simplex_name TEXT;
ALTER TABLE group_profiles ADD COLUMN simplex_name TEXT;
CREATE UNIQUE INDEX idx_contact_profiles_simplex_name
ON contact_profiles(user_id, simplex_name)
WHERE simplex_name IS NOT NULL;
CREATE UNIQUE INDEX idx_group_profiles_simplex_name
ON group_profiles(user_id, simplex_name)
WHERE simplex_name IS NOT NULL;
ALTER TABLE contacts ADD COLUMN simplex_name_verified_at TIMESTAMPTZ;
ALTER TABLE groups ADD COLUMN simplex_name_verified_at TIMESTAMPTZ;
ALTER TABLE contact_profiles ADD COLUMN contact_domain TEXT;
ALTER TABLE contact_profiles ADD COLUMN contact_domain_verification SMALLINT;
ALTER TABLE groups ADD COLUMN group_domain_verification SMALLINT;
ALTER TABLE server_operators ADD COLUMN smp_role_names SMALLINT NOT NULL DEFAULT 0;
UPDATE server_operators SET smp_role_names = 1 WHERE server_operator_tag = 'simplex';
@@ -66,17 +33,7 @@ down_m20260603_simplex_name =
[r|
ALTER TABLE server_operators DROP COLUMN smp_role_names;
ALTER TABLE groups DROP COLUMN simplex_name_verified_at;
ALTER TABLE contacts DROP COLUMN simplex_name_verified_at;
DROP INDEX idx_group_profiles_simplex_name;
DROP INDEX idx_contact_profiles_simplex_name;
ALTER TABLE group_profiles DROP COLUMN simplex_name;
ALTER TABLE contact_profiles DROP COLUMN simplex_name;
DROP INDEX idx_groups_simplex_name;
DROP INDEX idx_contacts_simplex_name;
ALTER TABLE connections DROP COLUMN simplex_name;
ALTER TABLE groups DROP COLUMN simplex_name;
ALTER TABLE contacts DROP COLUMN simplex_name;
ALTER TABLE groups DROP COLUMN group_domain_verification;
ALTER TABLE contact_profiles DROP COLUMN contact_domain_verification;
ALTER TABLE contact_profiles DROP COLUMN contact_domain;
|]
src/Simplex/Chat/Store/Profiles.hs
+12 -13
View File
@@ -110,7 +110,7 @@ import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..))
import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, ConnectionLink (..), CreatedConnLink (..), UserId)
import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, ConnectionLink (..), CreatedConnLink (..), SimplexNameInfo, 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
@@ -161,7 +161,7 @@ createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {di
(profileId, displayName, userId, BI True, currentTs, currentTs, currentTs)
contactId <- insertedRowId db
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
pure $ toUser currentTs $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing) :. localBadgeToRow Nothing :. Only Nothing
pure $ toUser currentTs $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing) :. localBadgeToRow Nothing :. (Nothing, Nothing)
-- TODO [mentions]
getUsersInfo :: DB.Connection -> IO [UserInfo]
@@ -332,7 +332,7 @@ updateUserProfile db user p'
currentTs <- getCurrentTime
updateUserProfileFields_' db userId profileId p' currentTs
userMemberProfileUpdatedAt' <- updateUserMemberProfileUpdatedAt_ currentTs
pure user {profile = (toLocalProfile profileId p' localAlias currentTs (Just False)) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
pure user {profile = (toLocalProfile profileId p' localAlias currentTs (Just False) Nothing) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
| otherwise =
checkConstraint SEDuplicateName . liftIO $ do
currentTs <- getCurrentTime
@@ -344,7 +344,7 @@ updateUserProfile db user p'
(newName, newName, userId, currentTs, currentTs)
updateUserProfileFields_' db userId profileId p' currentTs
updateContactLDN_ db user userContactId localDisplayName newName currentTs
pure user {localDisplayName = newName, profile = (toLocalProfile profileId p' localAlias currentTs (Just False)) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
pure user {localDisplayName = newName, profile = (toLocalProfile profileId p' localAlias currentTs (Just False) Nothing) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
where
updateUserMemberProfileUpdatedAt_ currentTs
| userMemberProfileChanged = do
@@ -354,10 +354,9 @@ updateUserProfile db user p'
userMemberProfileChanged = newName /= displayName || fn' /= fullName || d' /= shortDescr || img' /= image
User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, localBadge, localAlias}, userMemberProfileUpdatedAt} = user
Profile {displayName = newName, fullName = fn', shortDescr = d', image = img', preferences} = p'
-- contact_profiles.simplex_name is reserved for peer claims received via XInfo;
-- updateUserProfileFields_' deliberately does not write it. The user's own
-- broadcastable simplex_name lives on contacts.simplex_name (loaded by toUser
-- into User.profile.simplexName via uct.simplex_name).
-- contact_profiles.contact_domain (the broadcast name) is set out of band via the
-- set-name API, not through a regular profile edit; updateUserProfileFields_'
-- deliberately does not write it.
fullPreferences = fullPreferences' preferences
-- own profile field update; leaves the badge columns alone (the credential is owned by setUserBadge/addUserBadge)
@@ -410,14 +409,14 @@ getUserContactProfiles db User {userId} =
<$> DB.query
db
[sql|
SELECT display_name, full_name, short_descr, image, contact_link, chat_peer_type, simplex_name, preferences
SELECT display_name, full_name, short_descr, image, contact_link, chat_peer_type, contact_domain, preferences
FROM contact_profiles
WHERE user_id = ?
|]
(Only userId)
where
toContactProfile :: (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Text, Maybe Preferences) -> Profile
toContactProfile (displayName, fullName, shortDescr, image, contactLink, peerType, simplexNameRaw, preferences) = Profile {displayName, fullName, shortDescr, image, contactLink, simplexName = decodeSimplexName simplexNameRaw, peerType, preferences, badge = Nothing}
toContactProfile :: (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe SimplexNameInfo, Maybe Preferences) -> Profile
toContactProfile (displayName, fullName, shortDescr, image, contactLink, peerType, contactDomainRaw, preferences) = Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain = StrJSON <$> contactDomainRaw, peerType, preferences, badge = Nothing}
createUserContactLink :: DB.Connection -> User -> ConnId -> CreatedLinkContact -> SubscriptionMode -> ExceptT StoreError IO ()
createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMode =
@@ -429,7 +428,7 @@ createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMo
"INSERT INTO user_contact_links (user_id, conn_req_contact, short_link_contact, short_link_data_set, short_link_large_data_set, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(userId, cReq, shortLink, slDataSet, slDataSet, currentTs, currentTs)
userContactLinkId <- insertedRowId db
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff Nothing
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff
getUserAddressConnection :: DB.Connection -> StoreCxt -> User -> ExceptT StoreError IO Connection
getUserAddressConnection db cxt User {userId} = do
@@ -440,7 +439,7 @@ getUserAddressConnection db cxt User {userId} = do
SELECT 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.xcontact_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, c.simplex_name
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM connections c
JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
WHERE c.user_id = ? AND uc.user_id = ? AND uc.local_display_name = '' AND uc.group_id IS NULL
src/Simplex/Chat/Store/SQLite/Migrations/M20260603_simplex_name.hs
+13 -56
View File
@@ -5,56 +5,23 @@ module Simplex.Chat.Store.SQLite.Migrations.M20260603_simplex_name where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
-- contacts.simplex_name and groups.simplex_name are the source of truth for the
-- entity's current name (updated when XInfo/XGrpInfo arrives).
-- The entity name lives only on the profile: contact_profiles.contact_domain holds
-- the peer's broadcast contact name, and the existing group_profiles.group_domain
-- (from M20260515) holds the channel name. Both store the canonical strEncode form
-- as TEXT.
--
-- connections.simplex_name is a TRANSIENT carrier for the connect-via-plan
-- (connect-by-name) path: when the user initiates a connection by typing
-- #name.simplex, the peer's profile is not yet available, so the name is
-- stashed on the connection row. When XInfo arrives and the Contact row is
-- created, the XInfo handler in Library/Subscriber.hs reads
-- connections.simplex_name and passes it to createDirectContact. After contact
-- creation, contacts.simplex_name is canonical and the connection's value
-- becomes a historical snapshot - it is intentionally never UPDATEd.
--
-- contact_profiles.simplex_name and group_profiles.simplex_name hold the peer's
-- broadcast claim (received via XInfo/XGrpInfo).
--
-- contacts.simplex_name_verified_at and groups.simplex_name_verified_at record
-- when the user last verified (via RSLV) that the peer's claimed simplex_name
-- resolves to the link stored locally. NULL means unverified; it is cleared
-- back to NULL whenever the claim changes (updateContactProfile / updateGroupProfile).
-- contact_profiles.contact_domain_verification and groups.group_domain_verification
-- are the local 3-state verification status (NULL = not attempted, 0 = failed,
-- 1 = verified), reset to NULL when the claimed name changes.
--
-- server_operators.smp_role_names enables name resolution for an operator's SMP
-- servers (set for the simplex operator).
m20260603_simplex_name :: Query
m20260603_simplex_name =
[sql|
ALTER TABLE contacts ADD COLUMN simplex_name TEXT;
ALTER TABLE groups ADD COLUMN simplex_name TEXT;
ALTER TABLE connections ADD COLUMN simplex_name TEXT;
CREATE UNIQUE INDEX idx_contacts_simplex_name
ON contacts(user_id, simplex_name)
WHERE simplex_name IS NOT NULL AND deleted = 0;
CREATE UNIQUE INDEX idx_groups_simplex_name
ON groups(user_id, simplex_name)
WHERE simplex_name IS NOT NULL;
ALTER TABLE contact_profiles ADD COLUMN simplex_name TEXT;
ALTER TABLE group_profiles ADD COLUMN simplex_name TEXT;
CREATE UNIQUE INDEX idx_contact_profiles_simplex_name
ON contact_profiles(user_id, simplex_name)
WHERE simplex_name IS NOT NULL;
CREATE UNIQUE INDEX idx_group_profiles_simplex_name
ON group_profiles(user_id, simplex_name)
WHERE simplex_name IS NOT NULL;
ALTER TABLE contacts ADD COLUMN simplex_name_verified_at TEXT;
ALTER TABLE groups ADD COLUMN simplex_name_verified_at TEXT;
ALTER TABLE contact_profiles ADD COLUMN contact_domain TEXT;
ALTER TABLE contact_profiles ADD COLUMN contact_domain_verification INTEGER;
ALTER TABLE groups ADD COLUMN group_domain_verification INTEGER;
ALTER TABLE server_operators ADD COLUMN smp_role_names INTEGER NOT NULL DEFAULT 0;
UPDATE server_operators SET smp_role_names = 1 WHERE server_operator_tag = 'simplex';
@@ -65,17 +32,7 @@ down_m20260603_simplex_name =
[sql|
ALTER TABLE server_operators DROP COLUMN smp_role_names;
ALTER TABLE groups DROP COLUMN simplex_name_verified_at;
ALTER TABLE contacts DROP COLUMN simplex_name_verified_at;
DROP INDEX idx_group_profiles_simplex_name;
DROP INDEX idx_contact_profiles_simplex_name;
ALTER TABLE group_profiles DROP COLUMN simplex_name;
ALTER TABLE contact_profiles DROP COLUMN simplex_name;
DROP INDEX idx_groups_simplex_name;
DROP INDEX idx_contacts_simplex_name;
ALTER TABLE connections DROP COLUMN simplex_name;
ALTER TABLE groups DROP COLUMN simplex_name;
ALTER TABLE contacts DROP COLUMN simplex_name;
ALTER TABLE groups DROP COLUMN group_domain_verification;
ALTER TABLE contact_profiles DROP COLUMN contact_domain_verification;
ALTER TABLE contact_profiles DROP COLUMN contact_domain;
|]
src/Simplex/Chat/Store/Shared.hs
+51 -112
View File
@@ -49,10 +49,10 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..))
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Encoding.String (strDecode)
import Simplex.Messaging.Encoding.String (StrJSON (..))
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (AnyError (..), eitherToMaybe)
import Simplex.Messaging.Util (AnyError (..))
import Simplex.Messaging.Version
import UnliftIO.STM
#if defined(dbPostgres)
@@ -227,18 +227,13 @@ toFileInfo (fileId, fileStatus, filePath) = CIFileInfo {fileId, fileStatus, file
type EntityIdsRow = (Maybe Int64, Maybe Int64, Maybe Int64)
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, BoolInt, Maybe GroupLinkId, Maybe XContactId) :. (Maybe Int64, ConnStatus, ConnType, BoolInt, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, PQSupport, PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Int, Int, Maybe VersionChat, VersionChat, VersionChat) :. Only (Maybe Text)
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, BoolInt, Maybe GroupLinkId, Maybe XContactId) :. (Maybe Int64, ConnStatus, ConnType, BoolInt, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, PQSupport, PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Int, Int, Maybe VersionChat, VersionChat, VersionChat)
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe BoolInt, Maybe GroupLinkId, Maybe XContactId) :. (Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe BoolInt, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe PQSupport, Maybe PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Maybe Int, Maybe Int, Maybe VersionChat, Maybe VersionChat, Maybe VersionChat) :. Only (Maybe Text)
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe BoolInt, Maybe GroupLinkId, Maybe XContactId) :. (Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe BoolInt, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe PQSupport, Maybe PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Maybe Int, Maybe Int, Maybe VersionChat, Maybe VersionChat, Maybe VersionChat)
-- Maybe Text column holds the canonical strEncode form
-- (e.g. "simplex:/name@alice.simplex"); reads that fail to parse degrade
-- to Nothing rather than failing the whole row.
decodeSimplexName :: Maybe Text -> Maybe SimplexNameInfo
decodeSimplexName = (>>= eitherToMaybe . strDecode . encodeUtf8)
toConnection :: StoreCxt -> ConnectionRow -> Connection
toConnection cxt ((connId, acId, connLevel, viaContact, viaUserContactLink, BI viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, BI contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled, pqRcvEnabled, authErrCounter, quotaErrCounter, chatV, minVer, maxVer) :. Only simplexNameRaw) =
toConnection cxt ((connId, acId, connLevel, viaContact, viaUserContactLink, BI viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, BI contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled, pqRcvEnabled, authErrCounter, quotaErrCounter, chatV, minVer, maxVer)) =
Connection
{ connId,
agentConnId = AgentConnId acId,
@@ -263,8 +258,7 @@ toConnection cxt ((connId, acId, connLevel, viaContact, viaUserContactLink, BI v
pqRcvEnabled,
authErrCounter,
quotaErrCounter,
createdAt,
simplexName = decodeSimplexName simplexNameRaw
createdAt
}
where
peerChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
@@ -274,21 +268,13 @@ toConnection cxt ((connId, acId, connLevel, viaContact, viaUserContactLink, BI v
entityId_ ConnUserContact = userContactLinkId
toMaybeConnection :: StoreCxt -> MaybeConnectionRow -> Maybe Connection
toMaybeConnection cxt ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just pqSupport, Just pqEncryption, pqSndEnabled_, pqRcvEnabled_, Just authErrCounter, Just quotaErrCounter, connChatVersion, Just minVer, Just maxVer) :. Only simplexNameRaw) =
Just $ toConnection cxt ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled_, pqRcvEnabled_, authErrCounter, quotaErrCounter, connChatVersion, minVer, maxVer) :. Only simplexNameRaw)
toMaybeConnection cxt ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just pqSupport, Just pqEncryption, pqSndEnabled_, pqRcvEnabled_, Just authErrCounter, Just quotaErrCounter, connChatVersion, Just minVer, Just maxVer)) =
Just $ toConnection cxt ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled_, pqRcvEnabled_, authErrCounter, quotaErrCounter, connChatVersion, minVer, maxVer))
toMaybeConnection _ _ = Nothing
-- | Creates a new connection row. The @simplexName@ argument is a TRANSIENT
-- carrier for the connect-via-plan (connect-by-name) path: when the user
-- initiates a connection by typing #name.simplex, the peer's profile is not
-- yet available. The name is stashed on connections.simplex_name so that, when
-- XInfo arrives and the Contact row is created, the XInfo handler in
-- Library/Subscriber.hs (saveConnInfo) can read it and pass it to
-- createDirectContact. After contact creation, contacts.simplex_name is the
-- source of truth and the connection's value becomes a historical snapshot
-- that is intentionally never updated.
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> ConnStatus -> VersionChat -> VersionRangeChat -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> PQSupport -> Maybe SimplexNameInfo -> IO Connection
createConnection_ db userId connType entityId acId connStatus connChatVersion peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs subMode pqSup simplexName = do
-- | Creates a new connection row.
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> ConnStatus -> VersionChat -> VersionRangeChat -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> PQSupport -> IO Connection
createConnection_ db userId connType entityId acId connStatus connChatVersion peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs subMode pqSup = do
viaLinkGroupId :: Maybe Int64 <- fmap join . forM viaUserContactLink $ \ucLinkId ->
maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM user_contact_links WHERE user_id = ? AND user_contact_link_id = ? AND group_id IS NOT NULL" (userId, ucLinkId)
let viaGroupLink = isJust viaLinkGroupId
@@ -298,12 +284,12 @@ createConnection_ db userId connType entityId acId connStatus connChatVersion pe
INSERT INTO connections (
user_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, custom_user_profile_id, conn_status, conn_type,
contact_id, group_member_id, user_contact_link_id, created_at, updated_at,
conn_chat_version, peer_chat_min_version, peer_chat_max_version, to_subscribe, pq_support, pq_encryption, simplex_name
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
conn_chat_version, peer_chat_min_version, peer_chat_max_version, to_subscribe, pq_support, pq_encryption
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, connLevel, viaContact, viaUserContactLink, BI viaGroupLink, customUserProfileId, connStatus, connType)
:. (ent ConnContact, ent ConnMember, ent ConnUserContact, currentTs, currentTs)
:. (connChatVersion, minV, maxV, BI (subMode == SMOnlyCreate), pqSup, pqSup, simplexName)
:. (connChatVersion, minV, maxV, BI (subMode == SMOnlyCreate), pqSup, pqSup)
)
connId <- insertedRowId db
pure
@@ -331,8 +317,7 @@ createConnection_ db userId connType entityId acId connStatus connChatVersion pe
pqSndEnabled = Nothing,
pqRcvEnabled = Nothing,
authErrCounter = 0,
quotaErrCounter = 0,
simplexName
quotaErrCounter = 0
}
where
ent ct = if connType == ct then entityId else Nothing
@@ -429,62 +414,22 @@ setCommandConnId db User {userId} cmdId connId = do
createContact :: DB.Connection -> StoreCxt -> User -> Profile -> ExceptT StoreError IO ()
createContact db cxt user profile = do
currentTs <- liftIO getCurrentTime
void $ createContact_ db cxt user profile emptyChatPrefs Nothing "" currentTs Nothing
void $ createContact_ db cxt user profile emptyChatPrefs Nothing "" currentTs
-- | Clears simplex_name on any other contact_profiles row that holds the same
-- (user_id, simplex_name) so a subsequent UPDATE/INSERT setting that value
-- won't trip the partial UNIQUE index. Pass the profileId being updated to
-- exclude self; pass Nothing for the pre-INSERT case. Newer-claim-wins matches
-- RSLV semantics: the latest broadcast is the canonical assignment. The partial
-- UNIQUE index on (user_id, simplex_name) requires the prior holder be cleared
-- before the new row can set the name.
--
-- Cross-table collision with group_profiles.simplex_name is structurally
-- impossible: strEncode SimplexNameInfo prefixes contact names with '@' and
-- group names with '#', so the encoded bytes stored in the column never
-- overlap between the two tables.
clearConflictingContactProfileSimplexName_ :: DB.Connection -> UserId -> Maybe ProfileId -> Maybe SimplexNameInfo -> IO ()
clearConflictingContactProfileSimplexName_ _ _ _ Nothing = pure ()
clearConflictingContactProfileSimplexName_ db userId Nothing (Just simplexName) =
DB.execute
db
[sql|
UPDATE contact_profiles
SET simplex_name = NULL
WHERE user_id = ? AND simplex_name = ?
|]
(userId, simplexName)
clearConflictingContactProfileSimplexName_ db userId (Just profileId) (Just simplexName) =
DB.execute
db
[sql|
UPDATE contact_profiles
SET simplex_name = NULL
WHERE user_id = ? AND simplex_name = ? AND contact_profile_id <> ?
|]
(userId, simplexName, profileId)
-- | Inserts a new contact and its profile, returning the new contactId. A
-- peer-claimed Profile.simplexName that collides with an existing row (the
-- partial UNIQUE index on contact_profiles.(user_id, simplex_name)) displaces
-- the prior holder's name — newer-claim-wins.
createContact_ :: DB.Connection -> StoreCxt -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> Maybe SimplexNameInfo -> ExceptT StoreError IO ContactId
createContact_ db cxt User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, simplexName = profileSimplexName, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs simplexName =
-- | Inserts a new contact and its profile, returning the new contactId.
createContact_ :: DB.Connection -> StoreCxt -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> ExceptT StoreError IO ContactId
createContact_ db cxt User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs =
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
-- Clear any existing peer claim on the same simplex_name before INSERT
-- so the partial UNIQUE index doesn't reject the new row. Pass Nothing
-- as the excluded profileId — there's no self-row yet.
clearConflictingContactProfileSimplexName_ db userId Nothing profileSimplexName
badgeVerified <- verifyBadge_ (badgeKeys cxt) badge
DB.execute
db
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, chat_peer_type, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx, simplex_name) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified :. Only profileSimplexName)
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, chat_peer_type, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx, contact_domain) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified :. Only ((\(StrJSON n) -> n) <$> contactDomain))
profileId <- insertedRowId db
DB.execute
db
"INSERT INTO contacts (contact_profile_id, user_preferences, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id, simplex_name) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)"
((profileId, ctUserPreferences, ldn, userId, currentTs, currentTs, currentTs, BI True) :. toPreparedContactRow prepared :. Only simplexName)
"INSERT INTO contacts (contact_profile_id, user_preferences, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
((profileId, ctUserPreferences, ldn, userId, currentTs, currentTs, currentTs, BI True) :. toPreparedContactRow prepared)
contactId <- insertedRowId db
pure $ Right contactId
@@ -546,23 +491,22 @@ type PreparedContactRow = (Maybe AConnectionRequestUri, Maybe AConnShortLink, Ma
type GroupDirectInvitationRow = (Maybe ConnReqInvitation, Maybe GroupId, Maybe GroupMemberId, Maybe Int64, BoolInt)
type ContactRow' = (ProfileId, ContactName, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. PreparedContactRow :. (Maybe Int64, Maybe GroupMemberId, BoolInt) :. GroupDirectInvitationRow :. (Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64) :. BadgeRow :. (Maybe Text, Maybe Text, Maybe UTCTime)
type ContactRow' = (ProfileId, ContactName, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. PreparedContactRow :. (Maybe Int64, Maybe GroupMemberId, BoolInt) :. GroupDirectInvitationRow :. (Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64) :. BadgeRow :. (Maybe SimplexNameInfo, Maybe BoolInt)
type ContactRow = Only ContactId :. ContactRow'
-- ct.simplex_name -> Contact.simplexName (user's locally-known label)
-- cp.simplex_name -> LocalProfile.simplexName (peer's broadcast claim)
-- cp.contact_domain -> LocalProfile.contactDomain (peer's broadcast name claim);
-- cp.contact_domain_verification -> LocalProfile.contactDomainVerification
toContact :: UTCTime -> StoreCxt -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
toContact now cxt user chatTags ((Only contactId :. (profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow :. (ctSimplexNameRaw, cpSimplexNameRaw, simplexNameVerifiedAt)) :. connRow) =
let simplexName = decodeSimplexName ctSimplexNameRaw
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = decodeSimplexName cpSimplexNameRaw, peerType, localBadge = rowToBadge now badgeRow, preferences, localAlias}
toContact now cxt user chatTags ((Only contactId :. (profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow :. (cpContactDomain, cpContactDomainVerification)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = cpContactDomain, contactDomainVerification = unBI <$> cpContactDomainVerification, peerType, localBadge = rowToBadge now badgeRow, preferences, localAlias}
activeConn = toMaybeConnection cxt connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
incognito = maybe False connIncognito activeConn
mergedPreferences = contactUserPreferences user userPreferences preferences incognito
preparedContact = toPreparedContact preparedContactRow
groupDirectInv = toGroupDirectInvitation groupDirectInvRow
in Contact {contactId, localDisplayName, profile, activeConn, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, preparedContact, contactRequestId, contactGroupMemberId, contactGrpInvSent, groupDirectInv, chatTags, chatItemTTL, uiThemes, chatDeleted, customData, simplexName, simplexNameVerifiedAt}
in Contact {contactId, localDisplayName, profile, activeConn, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, preparedContact, contactRequestId, contactGroupMemberId, contactGrpInvSent, groupDirectInv, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
toPreparedContact :: PreparedContactRow -> Maybe PreparedContact
toPreparedContact (connFullLink, connShortLink, welcomeSharedMsgId, requestSharedMsgId) =
@@ -588,17 +532,17 @@ getProfileById db userId profileId = do
db
[sql|
SELECT cp.contact_profile_id, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, cp.preferences, -- , ct.user_preferences
cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra, cp.badge_master_key, cp.badge_signature, cp.badge_key_idx, cp.simplex_name
cp.badge_proof, cp.badge_pres_header, cp.badge_expiry, cp.badge_type, cp.badge_verified, cp.badge_extra, cp.badge_master_key, cp.badge_signature, cp.badge_key_idx, cp.contact_domain, cp.contact_domain_verification
FROM contact_profiles cp
WHERE cp.user_id = ? AND cp.contact_profile_id = ?
|]
(userId, profileId)
type ContactRequestRow = (Int64, ContactName, AgentInvId, Maybe ContactId, Maybe GroupId, Maybe Int64) :. (Int64, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias) :. (Maybe XContactId, PQSupport, Maybe SharedMsgId, Maybe SharedMsgId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat) :. BadgeRow :. Only (Maybe Text)
type ContactRequestRow = (Int64, ContactName, AgentInvId, Maybe ContactId, Maybe GroupId, Maybe Int64) :. (Int64, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias) :. (Maybe XContactId, PQSupport, Maybe SharedMsgId, Maybe SharedMsgId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat) :. BadgeRow :. (Maybe SimplexNameInfo, Maybe BoolInt)
toContactRequest :: UTCTime -> ContactRequestRow -> UserContactRequest
toContactRequest now ((contactRequestId, localDisplayName, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_) :. (profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias) :. (xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, preferences, createdAt, updatedAt, minVer, maxVer) :. badgeRow :. Only simplexNameRaw) = do
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = decodeSimplexName simplexNameRaw, peerType, preferences, localBadge = rowToBadge now badgeRow, localAlias}
toContactRequest now ((contactRequestId, localDisplayName, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_) :. (profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias) :. (xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, preferences, createdAt, updatedAt, minVer, maxVer) :. badgeRow :. (contactDomain, contactDomainVerification)) = do
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, peerType, preferences, localBadge = rowToBadge now badgeRow, localAlias}
cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
in UserContactRequest {contactRequestId, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_, cReqChatVRange, localDisplayName, profileId, profile, xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, createdAt, updatedAt}
@@ -607,17 +551,17 @@ userQuery =
[sql|
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, uct.simplex_name
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_verification
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
|]
toUser :: UTCTime -> (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, BoolInt, BoolInt, Maybe UIThemeEntityOverrides) :. BadgeRow :. Only (Maybe Text) -> User
toUser now ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, BI userChatRelay, BI clientService, uiThemes) :. badgeRow :. Only simplexNameRaw) =
toUser :: UTCTime -> (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, BoolInt, BoolInt, Maybe UIThemeEntityOverrides) :. BadgeRow :. (Maybe SimplexNameInfo, Maybe BoolInt) -> User
toUser now ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, BI userChatRelay, BI clientService, uiThemes) :. badgeRow :. (contactDomain, contactDomainVerification)) =
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts, viewPwdHash, userMemberProfileUpdatedAt, userChatRelay = BoolDef userChatRelay, clientService = BoolDef clientService, uiThemes}
where
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = decodeSimplexName simplexNameRaw, peerType, localBadge = rowToBadge now badgeRow, preferences = userPreferences, localAlias = ""}
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, peerType, localBadge = rowToBadge now badgeRow, preferences = userPreferences, localAlias = ""}
fullPreferences = fullPreferences' userPreferences
viewPwdHash = UserPwdHash <$> viewPwdHash_ <*> viewPwdSalt_
@@ -733,31 +677,26 @@ type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe Member
type GroupKeysRow = (Maybe C.PrivateKeyEd25519, Maybe C.PublicKeyEd25519, Maybe C.PrivateKeyEd25519)
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. PublicGroupAccessRow :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe VersionRoster, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. (Maybe Text, Maybe Text, Maybe UTCTime) :. GroupMemberRow
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. PublicGroupAccessRow :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe VersionRoster, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. Only (Maybe BoolInt) :. GroupMemberRow
type PublicGroupAccessRow = (Maybe Text, Maybe Text, Maybe BoolInt, Maybe BoolInt)
type PublicGroupAccessRow = (Maybe Text, Maybe SimplexNameInfo, Maybe BoolInt, Maybe BoolInt)
type GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact)
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences) :. BadgeRow :. Only (Maybe Text)
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences) :. BadgeRow :. (Maybe SimplexNameInfo, Maybe BoolInt)
toGroupInfo :: UTCTime -> StoreCxt -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
toGroupInfo now cxt userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, rosterVersion, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. (gSimplexNameRaw, gpSimplexNameRaw, simplexNameVerifiedAt) :. userMemberRow) =
toGroupInfo now cxt userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, rosterVersion, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. Only groupDomainVerification :. userMemberRow) =
let membership = (toGroupMember now userContactId userMemberRow) {memberChatVRange = vr cxt}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ (toPublicGroupAccess accessRow)
groupKeys = toGroupKeys publicGroupId_ groupKeysRow
-- groups.simplex_name is the user's locally-known group name (set by the
-- prepare-via-name path). group_profiles.simplex_name is the peer's
-- broadcast claim (written from XGrpInfo). They are kept distinct so the
-- user's locally-resolved label is not echoed back as canonical.
simplexName = decodeSimplexName gSimplexNameRaw
groupProfile = GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup, simplexName = decodeSimplexName gpSimplexNameRaw, groupPreferences, memberAdmission}
groupProfile = GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission}
businessChat = toBusinessChatInfo businessRow
preparedGroup = toPreparedGroup preparedGroupRow
groupSummary = GroupSummary {currentMembers, publicMemberCount}
in GroupInfo {groupId, useRelays = BoolDef useRelays, relayOwnStatus, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, preparedGroup, chatTags, chatItemTTL, uiThemes, groupSummary, rosterVersion, customData, membersRequireAttention, viaGroupLinkUri, groupKeys, simplexName, simplexNameVerifiedAt}
in GroupInfo {groupId, useRelays = BoolDef useRelays, relayOwnStatus, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, preparedGroup, chatTags, chatItemTTL, uiThemes, groupSummary, rosterVersion, customData, membersRequireAttention, viaGroupLinkUri, groupKeys, groupDomainVerification = unBI <$> groupDomainVerification}
toPreparedGroup :: PreparedGroupRow -> Maybe PreparedGroup
toPreparedGroup = \case
@@ -773,13 +712,13 @@ toPublicGroupProfile _ _ _ _ = Nothing
publicGroupAccessRow :: Maybe PublicGroupProfile -> PublicGroupAccessRow
publicGroupAccessRow pgp = case pgp >>= publicGroupAccess of
Just PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding} ->
(groupWebPage, groupDomain, Just (BI domainWebPage), Just (BI allowEmbedding))
(groupWebPage, (\(StrJSON n) -> n) <$> groupDomain, Just (BI domainWebPage), Just (BI allowEmbedding))
Nothing -> (Nothing, Nothing, Nothing, Nothing)
toPublicGroupAccess :: PublicGroupAccessRow -> Maybe PublicGroupAccess
toPublicGroupAccess (groupWebPage, groupDomain, domainWebPage_, allowEmbedding_)
| isJust groupWebPage || isJust groupDomain || domainWebPage || allowEmbedding =
Just PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding}
Just PublicGroupAccess {groupWebPage, groupDomain = StrJSON <$> groupDomain, domainWebPage, allowEmbedding}
| otherwise = Nothing
where
domainWebPage = maybe False unBI domainWebPage_
@@ -818,13 +757,13 @@ groupMemberQuery =
SELECT
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.simplex_name,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_verification,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link,
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.xcontact_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, c.simplex_name
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
@@ -835,8 +774,8 @@ toContactMember now cxt User {userContactId} (memberRow :. connRow) =
(toGroupMember now userContactId memberRow) {activeConn = toMaybeConnection cxt connRow}
rowToLocalProfile :: UTCTime -> ProfileRow -> LocalProfile
rowToLocalProfile now ((profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences) :. badgeRow :. Only simplexNameRaw) =
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = decodeSimplexName simplexNameRaw, peerType, localBadge = rowToBadge now badgeRow, localAlias, preferences}
rowToLocalProfile now ((profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences) :. badgeRow :. (contactDomain, contactDomainVerification)) =
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, peerType, localBadge = rowToBadge now badgeRow, localAlias, preferences}
toBusinessChatInfo :: BusinessChatInfoRow -> Maybe BusinessChatInfo
toBusinessChatInfo (Just chatType, Just businessId, Just customerId) = Just BusinessChatInfo {chatType, businessId, customerId}
@@ -860,12 +799,12 @@ groupInfoQueryFields =
g.use_relays, g.relay_own_status,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.roster_version, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.root_priv_key, g.root_pub_key, g.member_priv_key,
g.simplex_name, gp.simplex_name, g.simplex_name_verified_at,
g.group_domain_verification,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.index_in_group, 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, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra, pu.badge_master_key, pu.badge_signature, pu.badge_key_idx, pu.simplex_name,
pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra, pu.badge_master_key, pu.badge_signature, pu.badge_key_idx, pu.contact_domain, pu.contact_domain_verification,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts, mu.member_pub_key, mu.relay_link
|]
src/Simplex/Chat/Types.hs
+13 -23
View File
@@ -212,13 +212,7 @@ data Contact = Contact
chatItemTTL :: Maybe Int64,
uiThemes :: Maybe UIThemeEntityOverrides,
chatDeleted :: Bool,
customData :: Maybe CustomData,
simplexName :: Maybe SimplexNameInfo,
-- | Timestamp of the most recent successful RSLV verification of the peer's
-- simplex_name claim against this contact's connection link. NULL means the
-- claim is unverified (UI should surface an indicator). Cleared back to NULL
-- whenever simplex_name changes in updateContactProfile.
simplexNameVerifiedAt :: Maybe UTCTime
customData :: Maybe CustomData
}
deriving (Eq, Show)
@@ -500,10 +494,7 @@ data GroupInfo = GroupInfo
membersRequireAttention :: Int,
viaGroupLinkUri :: Maybe ConnReqContact,
groupKeys :: Maybe GroupKeys,
simplexName :: Maybe SimplexNameInfo,
-- | See 'Contact.simplexNameVerifiedAt'. Verified against the channel link
-- stored for the group; cleared by updateGroupProfile.
simplexNameVerifiedAt :: Maybe UTCTime
groupDomainVerification :: Maybe Bool
}
deriving (Eq, Show)
@@ -709,7 +700,7 @@ data Profile = Profile
preferences :: Maybe Preferences,
peerType :: Maybe ChatPeerType,
badge :: Maybe BadgeProof,
simplexName :: Maybe SimplexNameInfo
contactDomain :: Maybe (StrJSON "SimplexName" SimplexNameInfo)
-- fields that should not be read into this data type to prevent sending them as part of profile to contacts:
-- - contact_profile_id
-- - incognito
@@ -742,7 +733,7 @@ instance TextEncoding ChatPeerType where
profileFromName :: ContactName -> Profile
profileFromName displayName =
Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing, peerType = Nothing, badge = Nothing, simplexName = Nothing}
Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing, peerType = Nothing, badge = Nothing, contactDomain = Nothing}
-- check if profiles match ignoring preferences
profilesMatch :: LocalProfile -> LocalProfile -> Bool
@@ -793,22 +784,23 @@ data LocalProfile = LocalProfile
peerType :: Maybe ChatPeerType,
localBadge :: Maybe LocalBadge,
localAlias :: LocalAlias,
simplexName :: Maybe SimplexNameInfo
contactDomain :: Maybe SimplexNameInfo,
contactDomainVerification :: Maybe Bool
}
deriving (Eq, Show)
localProfileId :: LocalProfile -> ProfileId
localProfileId LocalProfile {profileId} = profileId
toLocalProfile :: ProfileId -> Profile -> LocalAlias -> UTCTime -> Maybe Bool -> LocalProfile
toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge, simplexName} localAlias now verified =
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, localAlias, simplexName}
toLocalProfile :: ProfileId -> Profile -> LocalAlias -> UTCTime -> Maybe Bool -> Maybe Bool -> LocalProfile
toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge, contactDomain} localAlias now verified nameVerified =
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, localAlias, contactDomain = (\(StrJSON n) -> n) <$> contactDomain, contactDomainVerification = nameVerified}
where
localBadge = (\b@(BadgeProof _ _ _ info) -> PeerBadge b (mkBadgeStatus now verified info)) <$> badge
fromLocalProfile :: LocalProfile -> Profile
fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, simplexName} =
Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = localBadge >>= wireBadge, simplexName}
fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, contactDomain} =
Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = localBadge >>= wireBadge, contactDomain = StrJSON <$> contactDomain}
where
-- any stored peer proof rides the wire (receivers verify independently); the own credential is presented fresh, and a display-only badge never sends
wireBadge :: LocalBadge -> Maybe BadgeProof
@@ -854,7 +846,7 @@ instance ToField GroupType where toField = toField . textEncode
data PublicGroupAccess = PublicGroupAccess
{ groupWebPage :: Maybe Text,
groupDomain :: Maybe Text,
groupDomain :: Maybe (StrJSON "SimplexName" SimplexNameInfo),
domainWebPage :: Bool,
allowEmbedding :: Bool
}
@@ -875,7 +867,6 @@ data GroupProfile = GroupProfile
description :: Maybe Text, -- this has been repurposed as welcome message
image :: Maybe ImageData,
publicGroup :: Maybe PublicGroupProfile,
simplexName :: Maybe SimplexNameInfo,
groupPreferences :: Maybe GroupPreferences,
memberAdmission :: Maybe GroupMemberAdmission
}
@@ -1829,8 +1820,7 @@ data Connection = Connection
pqRcvEnabled :: Maybe PQEncryption,
authErrCounter :: Int,
quotaErrCounter :: Int, -- if exceeds limit messages to group members are created as pending; sending to contacts is unaffected by this
createdAt :: UTCTime,
simplexName :: Maybe SimplexNameInfo
createdAt :: UTCTime
}
deriving (Eq, Show)
src/Simplex/Chat/View.hs
+17 -11
View File
@@ -1133,6 +1133,11 @@ shareLinkStr :: Maybe SimplexNameInfo -> B.ByteString -> B.ByteString
shareLinkStr (Just ni) _ = strEncode ni
shareLinkStr Nothing fallback = fallback
-- The channel's name (group_domain) for share-link display, if any.
groupDomainName :: GroupInfo -> Maybe SimplexNameInfo
groupDomainName GroupInfo {groupProfile = GroupProfile {publicGroup}} =
(\(StrJSON n) -> n) <$> (publicGroup >>= publicGroupAccess >>= groupDomain)
-- TODO [short links] show all settings
viewAddressSettings :: AddressSettings -> [StyledString]
viewAddressSettings AddressSettings {businessAddress, autoAccept, autoReply} = case autoAccept of
@@ -1147,10 +1152,10 @@ viewAddressSettings AddressSettings {businessAddress, autoAccept, autoReply} = c
_ -> ["auto_accept off"]
groupLink_ :: StyledString -> GroupInfo -> GroupLink -> [StyledString]
groupLink_ intro g@GroupInfo {simplexName} GroupLink {connLinkContact = CCLink cReq shortLink, acceptMemberRole} =
groupLink_ intro g GroupLink {connLinkContact = CCLink cReq shortLink, acceptMemberRole} =
[ intro,
"",
plain $ shareLinkStr simplexName $ maybe cReqStr strEncode shortLink,
plain $ shareLinkStr (groupDomainName g) $ maybe cReqStr strEncode shortLink,
"",
"Anybody can connect to you and join group as " <> showRole acceptMemberRole <> " with: " <> highlight' "/c <group_link_above>",
"to show it again: " <> highlight ("/show link #" <> viewGroupName g),
@@ -1224,12 +1229,12 @@ viewGroupRelays g relays =
<> map showRelay relays
viewGroupLinkRelaysUpdated :: GroupInfo -> GroupLink -> [GroupRelay] -> [StyledString]
viewGroupLinkRelaysUpdated g@GroupInfo {simplexName} groupLink relays =
viewGroupLinkRelaysUpdated g groupLink relays =
[ttyFullGroup g <> ": group link relays updated, current relays:"]
<> map showRelay relays
<>
[ "group link:",
plain $ shareLinkStr simplexName $ maybe cReqStr strEncode shortLink
plain $ shareLinkStr (groupDomainName g) $ maybe cReqStr strEncode shortLink
]
where
GroupLink {connLinkContact = CCLink cReq shortLink} = groupLink
@@ -1786,11 +1791,11 @@ viewContactBadge = maybe [] $ \lb ->
in [plain (textEncode badgeType <> " badge - " <> st), plain expiry]
viewContactInfo :: Contact -> Maybe ConnectionStats -> Maybe Profile -> [StyledString]
viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink, localBadge}, activeConn, uiThemes, customData, simplexName} stats incognitoProfile =
viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink, localBadge, contactDomain}, activeConn, uiThemes, customData} stats incognitoProfile =
["contact ID: " <> sShow contactId]
<> viewContactBadge localBadge
<> maybe [] viewConnectionStats stats
<> maybe [] (\l -> ["contact address: " <> plain (shareLinkStr simplexName (strEncode (simplexChatContact' l)))]) contactLink
<> maybe [] (\l -> ["contact address: " <> plain (shareLinkStr contactDomain (strEncode (simplexChatContact' l)))]) contactLink
<> maybe
["you've shared main profile with this contact"]
(\p -> ["you've shared incognito profile with this contact: " <> incognitoProfile' p])
@@ -2027,7 +2032,7 @@ viewGroupUpdated
viewAccess Nothing = " removed"
viewAccess (Just PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding}) =
maybe "" (\u -> " web=" <> plain u) groupWebPage
<> maybe "" (\d -> " domain=" <> plain d) groupDomain
<> maybe "" (\(StrJSON ni) -> " domain=" <> plain (strEncode ni)) groupDomain
<> (if domainWebPage then " domain_page=on" else "")
<> (if allowEmbedding then " embed=on" else "")
@@ -2127,7 +2132,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
ILPOwnLink -> [invLink "own link"]
ILPConnecting Nothing -> [invLink "connecting"]
ILPConnecting (Just ct) -> [invLink ("connecting to contact " <> ttyContact' ct)]
ILPKnown ct@Contact {simplexName = sn}
ILPKnown ct@Contact {profile = LocalProfile {contactDomain = sn}}
| nextConnectPrepared ct -> [invLink ("known prepared contact " <> ttyContact' ct)] <> simplexNameLine sn
| contactDeleted ct -> [invLink ("known deleted contact " <> ttyContact' ct)] <> simplexNameLine sn
| otherwise ->
@@ -2145,13 +2150,13 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
CAPOwnLink -> [ctAddr "own address"]
CAPConnectingConfirmReconnect -> [ctAddr "connecting, allowed to reconnect"]
CAPConnectingProhibit ct -> [ctAddr ("connecting to contact " <> ttyContact' ct)]
CAPKnown ct@Contact {simplexName = sn}
CAPKnown ct@Contact {profile = LocalProfile {contactDomain = sn}}
| nextConnectPrepared ct -> [ctAddr ("known prepared contact " <> ttyContact' ct)] <> simplexNameLine sn
| otherwise ->
[ctAddr ("known contact " <> ttyContact' ct)]
<> simplexNameLine sn
<> ["use " <> ttyToContact' ct <> highlight' "<message>" <> " to send messages"]
CAPContactViaAddress ct@Contact {simplexName = sn} -> [ctAddr ("known contact without connection " <> ttyContact' ct)] <> simplexNameLine sn
CAPContactViaAddress ct@Contact {profile = LocalProfile {contactDomain = sn}} -> [ctAddr ("known contact without connection " <> ttyContact' ct)] <> simplexNameLine sn
where
ctAddr = ("contact address: " <>)
addrOrBiz = \case
@@ -2168,7 +2173,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
GLPConnectingConfirmReconnect -> [grpLink "connecting, allowed to reconnect"]
GLPConnectingProhibit Nothing -> [grpLink "connecting"]
GLPConnectingProhibit (Just g) -> connecting g
GLPKnown g@GroupInfo {preparedGroup, membership = m, simplexName = sn} _ _ _ -> case preparedGroup of
GLPKnown g@GroupInfo {preparedGroup, membership = m} _ _ _ -> case preparedGroup of
Just PreparedGroup {connLinkStartedConnection} -> case memberStatus m of
GSMemUnknown
| connLinkStartedConnection -> connecting g
@@ -2179,6 +2184,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
| otherwise -> knownActive
_ -> knownActive
where
sn = groupDomainName g
knownActive =
[knownGroup ""]
<> simplexNameLine sn