mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-08-22 03:40:17 +00:00
remove spurious comments
This commit is contained in:
@@ -256,12 +256,10 @@ data NameClaimProof = NameClaimProof
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- the bytes a name proof signs over: the claimed name together with the link it is shown through
|
||||
nameProofPayload :: SimplexNameInfo -> ProofPresHeader -> ByteString
|
||||
nameProofPayload name presHeader = strEncode name <> strEncode presHeader
|
||||
|
||||
-- make a name proof: sign (the name and the link it is shown through) with the address owner key.
|
||||
-- linkOwnerId names the signing owner in the link's owner chain (Nothing = root key, used for a contact address).
|
||||
-- linkOwnerId names the signing owner in the link's owner chain (Nothing = root key for a contact address).
|
||||
signNameProof :: C.PrivateKeyEd25519 -> Maybe OwnerId -> SimplexNameInfo -> ProofPresHeader -> NameClaimProof
|
||||
signNameProof key linkOwnerId name presHeader =
|
||||
NameClaimProof
|
||||
@@ -277,7 +275,6 @@ verifyNameProofSig :: C.PublicKeyEd25519 -> SimplexNameInfo -> NameClaimProof ->
|
||||
verifyNameProofSig ownerKey name NameClaimProof {presHeader, signature} =
|
||||
C.verify' ownerKey signature (nameProofPayload name presHeader)
|
||||
|
||||
-- the link a proof is tied to (the one it can be checked against), if any
|
||||
proofPresHeaderLink :: ProofPresHeader -> Maybe AConnShortLink
|
||||
proofPresHeaderLink = \case
|
||||
PHSimplexLink lnk -> Just lnk
|
||||
|
||||
@@ -1492,10 +1492,7 @@ processChatCommand cxt nm = \case
|
||||
updateCallItemStatus user ct call receivedStatus Nothing $> Just call
|
||||
APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile)
|
||||
APISetUserName userId name_ -> withUserId userId $ \user@User {profile = oldLP@LocalProfile {contactLink = oldContactLink}} -> do
|
||||
-- When SETTING a name (§4.9 steps 1-4): require an address (getUserAddress fails if none; a long-link-only
|
||||
-- address gets a short link created, reusing the APIAddMyAddressShortLink path), verify the name resolves to
|
||||
-- it, and write the address short link into contactLink. When CLEARING (Nothing): just drop the name — no
|
||||
-- address fetch or short-link creation.
|
||||
-- setting a name needs an address (creating its short link if missing) that the name resolves to; clearing just drops it
|
||||
contactLink' <- case name_ of
|
||||
Nothing -> pure oldContactLink
|
||||
Just name -> do
|
||||
@@ -2014,8 +2011,6 @@ processChatCommand cxt nm = \case
|
||||
ccLink' <- shortenCreatedLink ccLink
|
||||
-- TODO PQ pass minVersion from the current range
|
||||
conn <- withFastStore' $ \db -> createDirectConnection db user connId ccLink' Nothing ConnNew incognitoProfile subMode initialChatVersion PQSupportOn
|
||||
-- a non-incognito invite from a user with a name + address: re-save the link data with an address-key proof bound to the invite link
|
||||
-- (1-time invites have no two-stage primitive, so the link is only known after creation — hence the re-save)
|
||||
unless (isJust incognitoProfile) $ do
|
||||
addressKey_ <- withFastStore' $ \db -> getUserAddressSigKey db user
|
||||
let CCLink _ inviteSLnk_ = ccLink'
|
||||
@@ -2334,8 +2329,6 @@ processChatCommand cxt nm = \case
|
||||
Right _ -> throwError $ ChatErrorStore SEDuplicateContactLink
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
gVar <- asks random
|
||||
-- generate the address root key client-side so the address has a stable signing key for name proofs;
|
||||
-- prepareConnectionLink makes no network call, so the link is known before its data is built (two-stage, as for channels)
|
||||
rootKey@(rootPubKey, rootPrivKey) <- liftIO $ atomically $ C.generateKeyPair gVar
|
||||
let entityId = C.sha256Hash $ C.pubKeyBytes rootPubKey
|
||||
(ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) rootKey entityId True Nothing
|
||||
@@ -3141,8 +3134,6 @@ processChatCommand cxt nm = \case
|
||||
case publicGroup of
|
||||
Just pg@PublicGroupProfile {groupLink, publicGroupAccess = existingAccess} -> do
|
||||
let PublicGroupAccess {groupDomain = newName_} = access
|
||||
-- §4.9: only when the NAME changes, verify it resolves to this channel's join link
|
||||
-- (a web=/embed= edit that leaves the name unchanged triggers no name check, so one command stays clean)
|
||||
when (newName_ /= (existingAccess >>= groupDomain)) $
|
||||
forM_ newName_ $ \(StrJSON name) -> do
|
||||
let SimplexNameInfo {nameDomain = domain} = name
|
||||
@@ -3881,7 +3872,6 @@ processChatCommand cxt nm = \case
|
||||
setMyAddressData user@User {userChatRelay, profile = LocalProfile {contactDomain = userName_}} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink sLnk_, addressSettings} = do
|
||||
conn <- withFastStore $ \db -> getUserAddressConnection db cxt user
|
||||
rootKey_ <- withFastStore' $ \db -> getUserAddressSigKey db user
|
||||
-- sign the user's name claim (if set) with the stored address root key, bound to the address link
|
||||
shortLinkProfile <- signAddressNameProof (ACSL SCMContact <$> sLnk_) rootKey_ userName_ <$> presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True)
|
||||
-- TODO [short links] do not save address to server if data did not change, spinners, error handling
|
||||
let userData
|
||||
@@ -4284,16 +4274,11 @@ 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 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
|
||||
Just ct@Contact {profile = LocalProfile {contactLink = ctLink_}} -> case preparedContact ct of
|
||||
Just PreparedContact {connLinkToConnect} -> pure (connLinkToConnect, CPContactAddress (CAPKnown ct))
|
||||
-- A verified contact essentially always has preparedContact; if it's somehow absent, still return
|
||||
-- the KNOWN contact (as the link-known path does), reusing its advertised address link rather than erroring.
|
||||
Nothing -> case ctLink_ of
|
||||
Just (CLFull cReq) -> pure (ACCL SCMContact (CCLink cReq Nothing), CPContactAddress (CAPKnown ct))
|
||||
Just (CLShort sLnk) ->
|
||||
@@ -4306,13 +4291,10 @@ processChatCommand cxt nm = \case
|
||||
NTPublicGroup -> do
|
||||
g_ <- withFastStore $ \db -> getGroupInfoBySimplexName db cxt user ni
|
||||
case g_ of
|
||||
-- Mirror gPlan at line ~4133 in the link-based path: a removed member is not a
|
||||
-- known-and-reconnectable group; treat as "not found" so the caller can try elsewhere.
|
||||
Just g | memberRemoved (membership g) -> resolveAndDispatch
|
||||
Just g@GroupInfo {groupProfile = GroupProfile {publicGroup}} -> case preparedGroup g of
|
||||
Just PreparedGroup {connLinkToConnect = ccLink} ->
|
||||
pure (ACCL SCMContact ccLink, CPGroupLink (GLPKnown g (BoolDef False) Nothing (ListDef [])))
|
||||
-- as for contacts: still return the KNOWN channel via its join link rather than erroring
|
||||
Nothing -> case publicGroup of
|
||||
Just PublicGroupProfile {groupLink} ->
|
||||
let l' = serverShortLink groupLink
|
||||
@@ -4774,11 +4756,6 @@ processChatCommand cxt nm = \case
|
||||
gVar <- asks random
|
||||
liftIO $ SharedMsgId <$> encodedRandomBytes gVar 12
|
||||
|
||||
-- | Dispatch a resolved NameRecord by eagerly preparing a contact/group row
|
||||
-- (the resolved link's embedded profile has 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
|
||||
@@ -4787,8 +4764,6 @@ dispatchResolvedRecord cxt nm user ni@SimplexNameInfo {nameType} NameRecord {nrS
|
||||
where
|
||||
prepareAndPlan :: AConnShortLink -> CM (ACreatedConnLink, ConnectionPlan)
|
||||
prepareAndPlan (ACSL SCMInvitation _) =
|
||||
-- The resolver returns long-term contact/channel links; an invitation
|
||||
-- link in a NameRecord is malformed for this flow.
|
||||
throwError $ chatErrorAgent $ AGENT $ A_LINK "RSLV returned an invitation link"
|
||||
prepareAndPlan (ACSL SCMContact l) = case l of
|
||||
CSLContact _ CCTContact _ _ | nameType == NTContact -> prepareContact l
|
||||
@@ -4807,7 +4782,6 @@ dispatchResolvedRecord cxt nm user ni@SimplexNameInfo {nameType} NameRecord {nrS
|
||||
let ccLink = CCLink cReq (Just l')
|
||||
accLink = ACCL SCMContact ccLink
|
||||
ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink Nothing
|
||||
-- created as verified — connecting by the resolved name verifies it
|
||||
let Contact {contactId = cId} = ct
|
||||
withStore' $ \db -> setContactDomainVerified db user cId True
|
||||
pure (accLink, CPContactAddress (CAPKnown ct))
|
||||
@@ -4826,24 +4800,15 @@ dispatchResolvedRecord cxt nm user ni@SimplexNameInfo {nameType} NameRecord {nrS
|
||||
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_
|
||||
-- created as verified — connecting by the resolved name verifies it
|
||||
let GroupInfo {groupId} = g
|
||||
withStore' $ \db -> setGroupDomainVerified db user groupId True
|
||||
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 use the
|
||||
-- agent's simplex:/ scheme, but the prepared row stores hostname-scheme,
|
||||
-- and the connect-plan / known-link lookups assume the hostname form.
|
||||
-- RSLV short links may use the agent's simplex:/ scheme; prepared rows and link lookups use the hostname form
|
||||
serverShortLink' :: ConnShortLink m -> ConnShortLink m
|
||||
serverShortLink' = \case
|
||||
CSLInvitation _ srv lnkId linkKey -> CSLInvitation SLSServer srv lnkId linkKey
|
||||
CSLContact _ ct srv linkKey -> CSLContact SLSServer ct srv linkKey
|
||||
|
||||
-- | Pick the primary link from the @NameRecord@ matching the queried name type.
|
||||
-- Each per-type field is a list of links (primary first, fallbacks after); the
|
||||
-- prepare flow uses the first non-empty entry. An empty list (record exists but
|
||||
-- advertises no link of this kind) is treated as "not found" — same UX as a
|
||||
-- local-store miss.
|
||||
firstNameLink :: SimplexNameType -> [Text] -> [Text] -> SimplexNameInfo -> Either ChatError Text
|
||||
firstNameLink nameType simplexChannel simplexContact ni =
|
||||
case filter (not . T.null) links of
|
||||
@@ -4899,7 +4864,6 @@ verifyName user nm claim connLink_ proof_ = case (proof_, connLink_) of
|
||||
then NVOVerified
|
||||
else NVOFailed "the name resolves to a different address — its owner did not sign this name proof"
|
||||
|
||||
-- the proof must be tied to the link the peer connected through, so it can't be reused on a different link
|
||||
proofBoundTo :: NameClaimProof -> AConnShortLink -> Bool
|
||||
proofBoundTo NameClaimProof {presHeader} connLink =
|
||||
maybe False (`sameConnShortLink` connLink) (proofPresHeaderLink presHeader)
|
||||
@@ -4917,22 +4881,18 @@ verifyProofKey nm user claim proof@NameClaimProof {linkOwnerId} resolvedText =
|
||||
pure $ maybe False (\key -> verifyNameProofSig key claim proof) key_
|
||||
_ -> pure False
|
||||
|
||||
-- the boolean to persist (Nothing = inconclusive — leave the stored status untouched)
|
||||
nameVerifyVerdict :: NameVerifyOutcome -> Maybe Bool
|
||||
nameVerifyVerdict = \case
|
||||
NVOVerified -> Just True
|
||||
NVOFailed _ -> Just False
|
||||
NVOInconclusive _ -> Nothing
|
||||
|
||||
-- the human-readable failure reason for the UI (Nothing = verified)
|
||||
nameVerifyReason :: NameVerifyOutcome -> Maybe Text
|
||||
nameVerifyReason = \case
|
||||
NVOVerified -> Nothing
|
||||
NVOFailed r -> Just r
|
||||
NVOInconclusive r -> Just r
|
||||
|
||||
-- | Verify a contact's claimed name (§4.6): persist the 3-state status and return the updated contact
|
||||
-- with a Nothing/Just-reason result. Network/resolver failures are reported as ChatErrorAgent (retryable).
|
||||
apiVerifyContactName :: User -> NetworkRequestMode -> ContactId -> CM ChatResponse
|
||||
apiVerifyContactName user nm contactId = do
|
||||
cxt <- chatStoreCxt
|
||||
@@ -4945,7 +4905,6 @@ apiVerifyContactName user nm contactId = do
|
||||
ct' <- withFastStore $ \db -> getContact db cxt user contactId
|
||||
pure $ CRContactNameVerified user ct' (nameVerifyReason outcome)
|
||||
|
||||
-- | Verify a public group's (channel's) claimed name (§4.6).
|
||||
apiVerifyPublicGroupName :: User -> NetworkRequestMode -> GroupId -> CM ChatResponse
|
||||
apiVerifyPublicGroupName user nm groupId = do
|
||||
cxt <- chatStoreCxt
|
||||
|
||||
@@ -381,9 +381,6 @@ processAgentMessageConn :: StoreCxt -> User -> ACorrId -> ConnId -> AEvent 'AECo
|
||||
processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = do
|
||||
-- Missing connection/entity errors here will be sent to the view but not shown as CRITICAL alert,
|
||||
-- as in this case no need to ACK message - we can't process messages for this connection anyway.
|
||||
-- SEDBBusyError will be re-thrown as CRITICAL (via `critical`) as it indicates a transient lock/IO
|
||||
-- condition that usually resolves after app restart. Other SEDBException kinds show up as
|
||||
-- non-CRITICAL store errors.
|
||||
entity <- critical agentConnId $ withStore (\db -> getConnectionEntity db cxt user $ AgentConnId agentConnId) >>= updateConnStatus
|
||||
case agentMessage of
|
||||
END -> case entity of
|
||||
|
||||
@@ -138,7 +138,6 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
|
||||
gm <-
|
||||
ExceptT $
|
||||
firstRow (toGroupAndMember currentTs c) (SEInternalError "referenced group member not found") $
|
||||
-- Mirrors Store/Shared.hs groupInfoQueryFields — keep column lists in sync.
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
|
||||
@@ -560,11 +560,6 @@ deleteUnusedProfile_ db userId profileId =
|
||||
:. (userId, profileId, userId, profileId, profileId)
|
||||
)
|
||||
|
||||
-- | 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
|
||||
-- with 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
|
||||
@@ -577,8 +572,6 @@ updateContactProfile db cxt user@User {userId} c p' = do
|
||||
Profile {displayName = newName, contactDomain, preferences} = p'
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ contactConnIncognito c
|
||||
claimChanged = prevDomain /= (unStrJSON <$> contactDomain)
|
||||
-- a name proof is never sent in a profile update (XInfo) from the peer (we never make or accept a PHTest name proof):
|
||||
-- keep the stored proof when the name is unchanged, drop it when the name changes (then it's unverified)
|
||||
p'' = (p' :: Profile) {contactDomainProof = if claimChanged then Nothing else prevProof}
|
||||
clearVerificationIfClaimChanged =
|
||||
when claimChanged $
|
||||
@@ -595,8 +588,6 @@ updateContactProfile db cxt user@User {userId} c p' = do
|
||||
clearVerificationIfClaimChanged
|
||||
pure $ Right c {localDisplayName = ldn, profile, mergedPreferences}
|
||||
|
||||
-- | 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
|
||||
|
||||
@@ -1080,9 +1080,6 @@ getGroupInfoBySimplexName db cxt user ni =
|
||||
Nothing -> pure Nothing
|
||||
Just gId -> Just <$> getGroupInfo db cxt user gId
|
||||
|
||||
-- | 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 $
|
||||
@@ -2645,9 +2642,6 @@ createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> Version
|
||||
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
|
||||
|
||||
-- | 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, publicGroup = oldPublicGroup}} p'@GroupProfile {displayName = newName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission}
|
||||
| displayName == newName = liftIO $ do
|
||||
@@ -2667,8 +2661,6 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
|
||||
groupClaim pg = unStrJSON <$> (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 group_domain_verification = NULL WHERE user_id = ? AND group_id = ?" (userId, groupId)
|
||||
@@ -2698,7 +2690,6 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
|
||||
(ldn, currentTs, userId, groupId)
|
||||
safeDeleteLDN db user localDisplayName
|
||||
|
||||
-- | 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
|
||||
|
||||
@@ -356,9 +356,6 @@ 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.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)
|
||||
@@ -389,8 +386,6 @@ setUserBadge db user@User {userId, profile = p@LocalProfile {profileId}} localBa
|
||||
DB.execute db "UPDATE users SET user_member_profile_updated_at = ? WHERE user_id = ?" (ts, userId)
|
||||
pure (user :: User) {profile = p {localBadge}, userMemberProfileUpdatedAt = Just ts}
|
||||
|
||||
-- set the user's own broadcast name (contact_profiles.contact_domain) out of band (see updateUserProfileFields_').
|
||||
-- The verifiable proof is not stored here; it is generated fresh when the address link data is re-saved.
|
||||
setUserSimplexName :: DB.Connection -> User -> Maybe SimplexNameInfo -> IO User
|
||||
setUserSimplexName db user@User {userId, profile = p@LocalProfile {profileId}} name_ = do
|
||||
ts <- getCurrentTime
|
||||
@@ -528,7 +523,6 @@ getUserAddress db User {userId} =
|
||||
ExceptT . firstRow toUserContactLink SEUserContactLinkNotFound $
|
||||
DB.query db (userContactLinkQuery <> " WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL") (Only userId)
|
||||
|
||||
-- the contact-address owner signing key, captured at address creation, used to sign the user's name proofs
|
||||
getUserAddressSigKey :: DB.Connection -> User -> IO (Maybe C.PrivateKeyEd25519)
|
||||
getUserAddressSigKey db User {userId} =
|
||||
fmap join . maybeFirstRow fromOnly $
|
||||
@@ -858,7 +852,6 @@ toServerOperator ((operatorId, operatorTag, tradeName, legalName, domains, BI en
|
||||
}
|
||||
where
|
||||
serverRolesSMP (BI storage, BI proxy, BI names) = ServerRoles {storage, proxy, names}
|
||||
-- XFTP has no names role; the column is SMP-only.
|
||||
serverRolesXFTP (BI storage, BI proxy) = ServerRoles {storage, proxy, names = False}
|
||||
|
||||
getOperatorConditions_ :: DB.Connection -> ServerOperator -> UsageConditions -> Maybe UsageConditions -> UTCTime -> IO ConditionsAcceptance
|
||||
|
||||
@@ -272,7 +272,6 @@ toMaybeConnection cxt ((Just connId, Just agentConnId, Just connLevel, viaContac
|
||||
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.
|
||||
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 ->
|
||||
@@ -416,7 +415,6 @@ createContact db cxt user profile = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
void $ createContact_ db cxt user profile emptyChatPrefs Nothing "" currentTs
|
||||
|
||||
-- | 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, contactDomainProof, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs =
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
|
||||
@@ -495,8 +493,6 @@ type ContactRow' = (ProfileId, ContactName, ContactName, Text, Maybe Text, Maybe
|
||||
|
||||
type ContactRow = Only ContactId :. ContactRow'
|
||||
|
||||
-- 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 :. (cpContactDomain, cpContactDomainVerification, cpContactDomainProof)) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = cpContactDomain, contactDomainVerification = unBI <$> cpContactDomainVerification, contactDomainProof = cpContactDomainProof, peerType, localBadge = rowToBadge now badgeRow, preferences, localAlias}
|
||||
@@ -784,7 +780,6 @@ toBusinessChatInfo _ = Nothing
|
||||
groupInfoQuery :: Query
|
||||
groupInfoQuery = groupInfoQueryFields <> " " <> groupInfoQueryFrom
|
||||
|
||||
-- Mirrored in Store/Connections.hs getGroupAndMember_ — keep column lists in sync.
|
||||
groupInfoQueryFields :: Query
|
||||
groupInfoQueryFields =
|
||||
[sql|
|
||||
|
||||
@@ -1127,19 +1127,14 @@ simplexChatContact' = \case
|
||||
CLFull (CRContactUri crData) -> CLFull $ CRContactUri crData {crScheme = simplexChat}
|
||||
l@(CLShort _) -> l
|
||||
|
||||
-- Prefer the canonical "simplex:/name@..." / "#..." URI when a
|
||||
-- SimplexNameInfo is present on the entity; fall back to the raw
|
||||
-- connection-link bytes.
|
||||
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}} =
|
||||
unStrJSON <$> (publicGroup >>= publicGroupAccess >>= groupDomain)
|
||||
|
||||
-- §4.7: the name-verification result line — "verified", or "not verified" with the reason.
|
||||
viewNameVerified :: Maybe SimplexNameInfo -> Maybe Text -> [StyledString]
|
||||
viewNameVerified name_ result =
|
||||
let nameStr = maybe "name" (\ni -> "simplex name " <> shortNameInfoStr ni) name_
|
||||
|
||||
Reference in New Issue
Block a user