mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-08-29 09:49:04 +00:00
simpler resolution, name proofs
This commit is contained in:
Evgeny @ SimpleX Chat
@@ -29,6 +29,10 @@ module Simplex.Chat.Badges
|
||||
maxFileSizeLegend,
|
||||
ProofPresHeaderTag (..),
|
||||
ProofPresHeader (..),
|
||||
ClaimProof (..),
|
||||
signNameProof,
|
||||
verifyNameProofSig,
|
||||
proofPresHeaderLink,
|
||||
BadgePurchase (..),
|
||||
BadgeMasterKey (..),
|
||||
BadgeRequest (..),
|
||||
@@ -65,11 +69,14 @@ import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, nominalDay)
|
||||
import Simplex.FileTransfer.Description (gb, maxFileSize)
|
||||
import Simplex.Messaging.Agent.Protocol (AConnShortLink (..), OwnerId)
|
||||
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), fromTextField_)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.BBS
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
|
||||
import Simplex.Messaging.SimplexName (SimplexNameInfo)
|
||||
import Simplex.Messaging.Util (decodeJSON, encodeJSON)
|
||||
#if defined(dbPostgres)
|
||||
import Database.PostgreSQL.Simple.FromField (FromField (..))
|
||||
import Database.PostgreSQL.Simple.ToField (ToField (..))
|
||||
@@ -197,37 +204,89 @@ 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 ProofPresHeaderTag = PHTestTag | PHUnknownTag Char
|
||||
data ProofPresHeaderTag = PHTestTag | PHSimplexLinkTag | PHUnknownTag Char
|
||||
|
||||
instance StrEncoding ProofPresHeaderTag where
|
||||
strEncode = B.singleton . \case
|
||||
PHTestTag -> 'T'
|
||||
PHSimplexLinkTag -> 'L'
|
||||
PHUnknownTag c -> c
|
||||
strP = tag <$> A.anyChar
|
||||
where
|
||||
tag = \case
|
||||
'T' -> PHTestTag
|
||||
'L' -> PHSimplexLinkTag
|
||||
c -> PHUnknownTag c
|
||||
|
||||
-- PHSimplexLink binds the proof to the link it is presented through (a 1-time
|
||||
-- invitation or a contact address), making it non-replayable across links.
|
||||
data ProofPresHeader
|
||||
= PHTest ByteString
|
||||
| PHSimplexLink AConnShortLink
|
||||
| PHUnknown Char ByteString
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance StrEncoding ProofPresHeader where
|
||||
strEncode = \case
|
||||
PHTest nonce -> strEncode PHTestTag <> nonce
|
||||
PHSimplexLink lnk -> strEncode PHSimplexLinkTag <> strEncode lnk
|
||||
PHUnknown c b -> strEncode (PHUnknownTag c) <> b
|
||||
strP =
|
||||
strP >>= \case
|
||||
PHTestTag -> PHTest <$> A.takeByteString
|
||||
PHSimplexLinkTag -> PHSimplexLink <$> strP
|
||||
PHUnknownTag c -> PHUnknown c <$> A.takeByteString
|
||||
|
||||
-- v6.5.x accepts both; v7 will reject PHTest/PHUnknown
|
||||
proofPresHeaderAccepted :: ProofPresHeader -> Bool
|
||||
proofPresHeaderAccepted = \case
|
||||
PHTest _ -> True
|
||||
PHSimplexLink _ -> True
|
||||
PHUnknown _ _ -> True
|
||||
|
||||
instance ToJSON ProofPresHeader where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
instance FromJSON ProofPresHeader where
|
||||
parseJSON = strParseJSON "ProofPresHeader"
|
||||
|
||||
-- A name claim proof: signed by the address owner's key (linkOwnerId = Just oid for a
|
||||
-- channel's delegated owner, Nothing = the address root key) over
|
||||
-- strEncode name <> strEncode presHeader, bound to the presentation context (the link).
|
||||
data ClaimProof = ClaimProof
|
||||
{ linkOwnerId :: Maybe (StrJSON "OwnerId" OwnerId),
|
||||
presHeader :: ProofPresHeader,
|
||||
signature :: C.Signature 'C.Ed25519
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- the bytes a name proof signs over: the claimed name bound to its presentation context
|
||||
nameProofPayload :: SimplexNameInfo -> ProofPresHeader -> ByteString
|
||||
nameProofPayload name presHeader = strEncode name <> strEncode presHeader
|
||||
|
||||
-- mint a name proof: sign (name, presentation context) with the address owner key.
|
||||
-- linkOwnerId names the signing owner in the link's owner chain (Nothing = root key, the contact-address case).
|
||||
signNameProof :: C.PrivateKeyEd25519 -> Maybe OwnerId -> SimplexNameInfo -> ProofPresHeader -> ClaimProof
|
||||
signNameProof key linkOwnerId name presHeader =
|
||||
ClaimProof
|
||||
{ linkOwnerId = StrJSON <$> linkOwnerId,
|
||||
presHeader,
|
||||
signature = C.sign' key (nameProofPayload name presHeader)
|
||||
}
|
||||
|
||||
-- verify a name proof's signature against the resolved address owner key. The caller must
|
||||
-- SEPARATELY check the proof's presHeader link is the link it is presented through (anti-replay).
|
||||
verifyNameProofSig :: C.PublicKeyEd25519 -> SimplexNameInfo -> ClaimProof -> Bool
|
||||
verifyNameProofSig ownerKey name ClaimProof {presHeader, signature} =
|
||||
C.verify' ownerKey signature (nameProofPayload name presHeader)
|
||||
|
||||
-- the link a proof is bound to (its anti-replay context), if any
|
||||
proofPresHeaderLink :: ProofPresHeader -> Maybe AConnShortLink
|
||||
proofPresHeaderLink = \case
|
||||
PHSimplexLink lnk -> Just lnk
|
||||
_ -> Nothing
|
||||
|
||||
-- Payment proof
|
||||
|
||||
data BadgePurchase
|
||||
@@ -392,6 +451,13 @@ $(JQ.deriveJSON defaultJSON ''BadgeCredential)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''BadgeProof)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''ClaimProof)
|
||||
|
||||
-- ClaimProof is stored as JSON in contact_profiles.contact_domain_proof (like a badge proof)
|
||||
instance ToField ClaimProof where toField = toField . encodeJSON
|
||||
|
||||
instance FromField ClaimProof where fromField = fromTextField_ decodeJSON
|
||||
|
||||
-- LocalBadge is sent to the UI/clients WITHOUT crypto - only disclosed info + status. The credential/proof
|
||||
-- bytes stay core-side. FromJSON reconstructs a display-only badge (empty proof) for read-only consumers
|
||||
-- (remote host, UI echoes); the authoritative badge is loaded from the DB (rowToBadge), never from this JSON.
|
||||
|
||||
@@ -417,6 +417,7 @@ data ChatCommand
|
||||
| APIGetCallInvitations
|
||||
| APICallStatus ContactId WebRTCCallStatus
|
||||
| APIUpdateProfile {userId :: UserId, profile :: Profile}
|
||||
| APISetUserName {userId :: UserId, simplexName :: Maybe SimplexNameInfo}
|
||||
| APISetContactPrefs {contactId :: ContactId, preferences :: Preferences}
|
||||
| APISetContactAlias {contactId :: ContactId, localAlias :: LocalAlias}
|
||||
| APISetGroupAlias {groupId :: GroupId, localAlias :: LocalAlias}
|
||||
|
||||
@@ -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, contactDomain = Nothing}
|
||||
mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing, contactDomainProof = 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
|
||||
|
||||
@@ -55,7 +55,7 @@ import Data.Type.Equality
|
||||
import qualified Data.UUID as UUID
|
||||
import qualified Data.UUID.V4 as V4
|
||||
import Simplex.Chat.Library.Subscriber
|
||||
import Simplex.Chat.Badges (BadgeCredential (..), LocalBadge (..), maxXFTPFileSize, mkBadgeStatus, verifyCredential)
|
||||
import Simplex.Chat.Badges (BadgeCredential (..), ClaimProof (..), LocalBadge (..), ProofPresHeader (..), maxXFTPFileSize, mkBadgeStatus, proofPresHeaderLink, signNameProof, verifyCredential, verifyNameProofSig)
|
||||
import Simplex.Chat.Call
|
||||
import Simplex.Chat.Controller
|
||||
import Simplex.Chat.Delivery (DeliveryJobScope (..), DeliveryJobSpec (..), DeliveryWorkerScope (..))
|
||||
@@ -1491,6 +1491,23 @@ processChatCommand cxt nm = \case
|
||||
withCurrentCall contactId $ \user ct call ->
|
||||
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
|
||||
-- require an address with a short link: the name needs a verifiable link context to attach to
|
||||
UserContactLink {shortLinkDataSet, connLinkContact = CCLink ourFull_ ourShort_} <- withFastStore $ \db -> getUserAddress db user
|
||||
unless shortLinkDataSet $ throwCmdError "create your address short link before setting a name"
|
||||
let ourLink = maybe (CLFull ourFull_) CLShort ourShort_
|
||||
-- §4.9: names are pre-registered out of band; verify the name resolves to THIS address before setting it
|
||||
forM_ name_ $ \name -> do
|
||||
let SimplexNameInfo {nameDomain = domain} = name
|
||||
a <- asks smpAgent
|
||||
NameRecord {nrSimplexContact} <- liftIO (runExceptT $ resolveSimplexName a nm (aUserId user) domain) >>= either (throwError . chatErrorAgent) pure
|
||||
unless (any (`linksMatch` ourLink) nrSimplexContact) $ throwCmdError "name is not registered to your address"
|
||||
-- §4.9 step 3: a name in the profile must carry its address, so write the address short link into contactLink
|
||||
-- alongside the name. updateProfile_ then re-publishes the address (signing the proof) and broadcasts to contacts.
|
||||
let p' = (fromLocalProfile oldLP :: Profile) {contactDomain = StrJSON <$> name_, contactLink = maybe oldContactLink (const (Just ourLink)) name_}
|
||||
updateProfile_ user p' True $ withFastStore $ \db -> do
|
||||
user' <- updateUserProfile db user p'
|
||||
liftIO $ setUserSimplexName db user' name_
|
||||
APISetContactPrefs contactId prefs' -> withUser $ \user -> do
|
||||
ct <- withFastStore $ \db -> getContact db cxt user contactId
|
||||
updateContactPrefs user ct prefs'
|
||||
@@ -1979,7 +1996,7 @@ processChatCommand cxt nm = \case
|
||||
EnableGroupMember gName mName -> withMemberName gName mName $ \gId mId -> APIEnableGroupMember gId mId
|
||||
ChatHelp section -> pure $ CRChatHelp section
|
||||
Welcome -> withUser $ pure . CRWelcome
|
||||
APIAddContact userId incognito -> withUserId userId $ \user -> do
|
||||
APIAddContact userId incognito -> withUserId userId $ \user@User {profile = LocalProfile {contactDomain = userName_}} -> do
|
||||
-- [incognito] generate profile for connection
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
@@ -1990,6 +2007,13 @@ 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'
|
||||
proofProfile = signAddressNameProof (ACSL SCMInvitation <$> inviteSLnk_) addressKey_ userName_ linkProfile
|
||||
when (proofProfile /= linkProfile) $ void $ updatePCCShortLinkData conn proofProfile
|
||||
pure $ CRInvitation user ccLink' conn
|
||||
AddContact incognito -> withUser $ \User {userId} ->
|
||||
processChatCommand cxt nm $ APIAddContact userId incognito
|
||||
@@ -2301,16 +2325,22 @@ processChatCommand cxt nm = \case
|
||||
Left e -> throwError $ ChatErrorStore e
|
||||
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
|
||||
ccLink' <- shortenCreatedLink ccLink
|
||||
-- TODO [relays] relay: add identity, key to link data?
|
||||
userData <-
|
||||
if isTrue userChatRelay
|
||||
then pure $ relayShortLinkData (userProfileDirect user Nothing Nothing True)
|
||||
else (`contactShortLinkData` Nothing) <$> presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True)
|
||||
let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
|
||||
(connId, ccLink) <- withAgent $ \a -> createConnection a nm (aUserId user) True True SCMContact (Just userLinkData) Nothing IKPQOn subMode
|
||||
ccLink' <- shortenCreatedLink ccLink
|
||||
connId <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData IKPQOn subMode
|
||||
let ccLink'' = if isTrue userChatRelay then setShortLinkType CCTRelay ccLink' else ccLink'
|
||||
withFastStore $ \db -> createUserContactLink db user connId ccLink'' subMode
|
||||
withFastStore $ \db -> createUserContactLink db user connId ccLink'' subMode rootPrivKey
|
||||
pure $ CRUserContactLinkCreated user ccLink''
|
||||
CreateMyAddress -> withUser $ \User {userId} ->
|
||||
processChatCommand cxt nm $ APICreateMyAddress userId
|
||||
@@ -3101,7 +3131,17 @@ processChatCommand cxt nm = \case
|
||||
gInfo@GroupInfo {groupProfile = p@GroupProfile {publicGroup}} <- withStore $ \db ->
|
||||
getGroupIdByName db user gName >>= getGroupInfo db cxt user
|
||||
case publicGroup of
|
||||
Just pg -> runUpdateGroupProfile user gInfo p {publicGroup = Just pg {publicGroupAccess = Just access}}
|
||||
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_ ((\(StrJSON n) -> n) <$> newName_) $ \name -> do
|
||||
let SimplexNameInfo {nameDomain = domain} = name
|
||||
a <- asks smpAgent
|
||||
NameRecord {nrSimplexChannel} <- liftIO (runExceptT $ resolveSimplexName a nm (aUserId user) domain) >>= either (throwError . chatErrorAgent) pure
|
||||
unless (any (`linksMatch` CLShort groupLink) nrSimplexChannel) $ throwCmdError "name is not registered to this channel"
|
||||
runUpdateGroupProfile user gInfo p {publicGroup = Just pg {publicGroupAccess = Just (signChannelNameProof gInfo pg access)}}
|
||||
Nothing -> throwChatError $ CECommandError "not a public group"
|
||||
APICreateGroupLink groupId mRole -> withUser $ \user -> withGroupLock "createGroupLink" groupId $ do
|
||||
gInfo@GroupInfo {groupProfile} <- withFastStore $ \db -> getGroupInfo db cxt user groupId
|
||||
@@ -3744,9 +3784,7 @@ processChatCommand cxt nm = \case
|
||||
-- gInfo_ is Maybe (Maybe GroupInfo), where Just Nothing means "some unknown group", e.g. when joining via link without profile
|
||||
profileToSend <-
|
||||
presentUserBadge user incognitoProfile $ case gInfo_ of
|
||||
Just gInfo_' ->
|
||||
let allowSimplexLinks = maybe True groupUserAllowSimplexLinks gInfo_'
|
||||
in userProfileInGroup' user allowSimplexLinks incognitoProfile
|
||||
Just gInfo_' -> userProfileInGroup' user gInfo_' incognitoProfile
|
||||
Nothing -> userProfileDirect user incognitoProfile Nothing True
|
||||
dm <- case gInfo_ of
|
||||
Just (Just gInfo) | useRelays' gInfo -> case relayMemberId_ of
|
||||
@@ -3829,9 +3867,11 @@ processChatCommand cxt nm = \case
|
||||
fmap $ \SndMessage {msgId, msgBody} ->
|
||||
(conn, MsgFlags {notification = hasNotification XInfo_}, (vrValue msgBody, [msgId]))
|
||||
setMyAddressData :: User -> UserContactLink -> CM UserContactLink
|
||||
setMyAddressData user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _sLnk_, addressSettings} = do
|
||||
setMyAddressData user@User {userChatRelay, profile = LocalProfile {contactDomain = userName_}} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink sLnk_, addressSettings} = do
|
||||
conn <- withFastStore $ \db -> getUserAddressConnection db cxt user
|
||||
shortLinkProfile <- presentUserBadge user Nothing $ userProfileDirect user Nothing Nothing True
|
||||
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
|
||||
| isTrue userChatRelay = relayShortLinkData shortLinkProfile
|
||||
@@ -4054,9 +4094,8 @@ processChatCommand cxt nm = \case
|
||||
conn <- createRelayConnection db cxt user (groupMemberId' relayMember) connId ConnPrepared chatV subMode
|
||||
pure (relayMember, conn, groupRelay)
|
||||
let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
||||
allowSimplexLinks = groupUserAllowSimplexLinks gInfo
|
||||
GroupMember {memberId = relayMemberId} = relayMember
|
||||
membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile allowSimplexLinks $ fromLocalProfile $ memberProfile membership
|
||||
membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
|
||||
let relayInv = GroupRelayInvitation {
|
||||
fromMember = MemberIdRole userMemberId userRole,
|
||||
fromMemberProfile = membershipProfile,
|
||||
@@ -4737,9 +4776,15 @@ dispatchResolvedRecord cxt nm user ni@SimplexNameInfo {nameType} NameRecord {nrS
|
||||
(FixedLinkData {linkConnReq = cReq}, cData) <- getShortLinkConnReq nm user l'
|
||||
ContactShortLinkData {profile} <-
|
||||
liftIO (decodeLinkUserData cData) >>= maybe (throwError $ chatErrorAgent $ AGENT $ A_LINK "could not decode contact profile from RSLV link") pure
|
||||
-- consent gate: the resolved profile must claim the resolved name, else "name unknown"
|
||||
let Profile {contactDomain} = profile
|
||||
unless (((\(StrJSON n) -> n) <$> contactDomain) == Just ni) $ throwChatError $ CESimplexNameNotFound ni
|
||||
let ccLink = CCLink cReq (Just l')
|
||||
accLink = ACCL SCMContact ccLink
|
||||
ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink Nothing
|
||||
-- born verified: connecting via the resolved name verifies it
|
||||
let Contact {contactId = cId} = ct
|
||||
withStore' $ \db -> setContactDomainVerified db user cId True
|
||||
pure (accLink, CPContactAddress (CAPKnown ct))
|
||||
prepareGroup :: ConnShortLink 'CMContact -> CM (ACreatedConnLink, ConnectionPlan)
|
||||
prepareGroup l = do
|
||||
@@ -4747,12 +4792,18 @@ dispatchResolvedRecord cxt nm user ni@SimplexNameInfo {nameType} NameRecord {nrS
|
||||
(FixedLinkData {linkConnReq = cReq}, cData@(ContactLinkData _ UserContactData {direct})) <- getShortLinkConnReq' nm user l'
|
||||
GroupShortLinkData {groupProfile, publicGroupData = publicGroupData_} <-
|
||||
liftIO (decodeLinkUserData cData) >>= maybe (throwError $ chatErrorAgent $ AGENT $ A_LINK "could not decode group profile from RSLV link") pure
|
||||
-- consent gate: the resolved group profile must claim the resolved name
|
||||
let GroupProfile {publicGroup} = groupProfile
|
||||
unless (((\(StrJSON n) -> n) <$> (publicGroup >>= publicGroupAccess >>= groupDomain)) == Just ni) $ throwChatError $ CESimplexNameNotFound ni
|
||||
let publicMemberCount_ = (\PublicGroupData {publicMemberCount} -> publicMemberCount) <$> publicGroupData_
|
||||
useRelays = not direct
|
||||
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_
|
||||
-- born verified: connecting via 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 carry the
|
||||
@@ -4804,10 +4855,19 @@ linksMatch resolved stored = case strDecode (encodeUtf8 resolved) :: Either Stri
|
||||
-- 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.
|
||||
-- sign the channel's name claim with the owner's member key, bound to the channel link
|
||||
-- (linkOwnerId = Just memberId — channels have delegated owners). No-op without a name or keys.
|
||||
signChannelNameProof :: GroupInfo -> PublicGroupProfile -> PublicGroupAccess -> PublicGroupAccess
|
||||
signChannelNameProof GroupInfo {groupKeys, membership = GroupMember {memberId = MemberId mid}} PublicGroupProfile {groupLink} access@PublicGroupAccess {groupDomain} =
|
||||
case (groupDomain, groupKeys) of
|
||||
(Just (StrJSON name), Just GroupKeys {memberPrivKey}) ->
|
||||
access {groupDomainProof = Just $ signNameProof memberPrivKey (Just mid) name (PHSimplexLink (ACSL SCMContact groupLink))}
|
||||
_ -> access
|
||||
|
||||
apiVerifySimplexName :: User -> NetworkRequestMode -> ChatRef -> CM ChatResponse
|
||||
apiVerifySimplexName user nm chatRef = do
|
||||
cxt <- chatStoreCxt
|
||||
(claim, storedLink, persistVerified) <- loadClaimAndLink cxt
|
||||
(claim, connLink_, proof_, persistVerified) <- loadClaimAndLink cxt
|
||||
let SimplexNameInfo {nameType = nameType', nameDomain = domain} = claim
|
||||
User {userId} = user
|
||||
a <- asks smpAgent
|
||||
@@ -4816,33 +4876,52 @@ apiVerifySimplexName user nm chatRef = do
|
||||
let resolvedLinks = case nameType' of
|
||||
NTContact -> nrSimplexContact
|
||||
NTPublicGroup -> nrSimplexChannel
|
||||
-- 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
|
||||
-- §4.6: a name verifies when its proof is signed by the resolved name's owner key (selected by
|
||||
-- linkOwnerId — root key for Nothing, owner-chain key for a channel's Just oid) AND the proof's
|
||||
-- presHeader is the link the peer was actually connected through (anti-replay). The key comes from
|
||||
-- *resolving the name* (the address), not the connected link — for a 1-time invite they differ.
|
||||
verified <- case (proof_, connLink_) of
|
||||
(Just proof, Just connLink)
|
||||
| proofBoundTo proof connLink -> or <$> mapM (verifyProofKey claim proof) resolvedLinks
|
||||
_ -> pure False
|
||||
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 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 -> Bool -> IO ())
|
||||
-- the claim, the link the peer was connected through (the presHeader anchor), the proof, and the 3-state persist callback
|
||||
loadClaimAndLink :: StoreCxt -> CM (SimplexNameInfo, Maybe AConnShortLink, Maybe ClaimProof, DB.Connection -> Bool -> IO ())
|
||||
loadClaimAndLink cxt = case chatRef of
|
||||
ChatRef CTDirect cId _ -> do
|
||||
ct <- withFastStore $ \db -> getContact db cxt user cId
|
||||
let Contact {contactId, profile = LocalProfile {contactLink, contactDomain}} = ct
|
||||
let Contact {contactId, profile = LocalProfile {contactDomain, contactDomainProof}, preparedContact} = 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 verified -> setContactDomainVerified db user contactId verified)
|
||||
let connLink_ = preparedContact >>= \PreparedContact {connLinkToConnect = ACCL m (CCLink _ sLnk_)} -> ACSL m <$> sLnk_
|
||||
pure (claim, connLink_, contactDomainProof, \db verified -> setContactDomainVerified db user contactId verified)
|
||||
ChatRef CTGroup gId _ -> do
|
||||
g <- withFastStore $ \db -> getGroupInfo db cxt user gId
|
||||
let GroupInfo {groupId, groupProfile = GroupProfile {publicGroup}, preparedGroup} = g
|
||||
gName = (\(StrJSON n) -> n) <$> (publicGroup >>= publicGroupAccess >>= groupDomain)
|
||||
gProof = publicGroup >>= publicGroupAccess >>= groupDomainProof
|
||||
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 verified -> setGroupDomainVerified db user groupId verified)
|
||||
let connLink_ = preparedGroup >>= \PreparedGroup {connLinkToConnect = CCLink _ sLnk_} -> ACSL SCMContact <$> sLnk_
|
||||
pure (claim, connLink_, gProof, \db verified -> setGroupDomainVerified db user groupId verified)
|
||||
_ -> throwCmdError "APIVerifySimplexName supports only direct and group chat refs"
|
||||
-- the proof must be bound (anti-replay) to the link the peer was connected through
|
||||
proofBoundTo :: ClaimProof -> AConnShortLink -> Bool
|
||||
proofBoundTo ClaimProof {presHeader} connLink =
|
||||
(strEncode <$> proofPresHeaderLink presHeader) == Just (strEncode connLink)
|
||||
-- verify the proof signature against the resolved name's owner key
|
||||
verifyProofKey :: SimplexNameInfo -> ClaimProof -> Text -> CM Bool
|
||||
verifyProofKey claim proof@ClaimProof {linkOwnerId} resolvedText =
|
||||
case strDecode (encodeUtf8 resolvedText) :: Either String AConnectionLink of
|
||||
Right (ACL SCMContact (CLShort sLnk)) ->
|
||||
tryAllErrors (getShortLinkConnReq nm user sLnk) >>= \case
|
||||
Right (FixedLinkData {rootKey}, ContactLinkData _ UserContactData {owners}) ->
|
||||
let key_ = case linkOwnerId of
|
||||
Nothing -> Just rootKey
|
||||
Just (StrJSON oid) -> ownerKey <$> find (\OwnerAuth {ownerId} -> ownerId == oid) owners
|
||||
in pure $ maybe False (\key -> verifyNameProofSig key claim proof) key_
|
||||
_ -> pure False
|
||||
_ -> pure False
|
||||
|
||||
data ConnectViaContactResult
|
||||
= CVRConnectedContact Contact
|
||||
@@ -5320,6 +5399,7 @@ chatCommandP =
|
||||
"/_call status @" *> (APICallStatus <$> A.decimal <* A.space <*> strP),
|
||||
"/_call get" $> APIGetCallInvitations,
|
||||
"/_profile " *> (APIUpdateProfile <$> A.decimal <* A.space <*> jsonP),
|
||||
"/_set_name " *> (APISetUserName <$> A.decimal <*> optional (A.space *> strP)),
|
||||
"/_set alias @" *> (APISetContactAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
|
||||
"/_set alias #" *> (APISetGroupAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
|
||||
"/_set alias :" *> (APISetConnectionAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
|
||||
@@ -5668,7 +5748,7 @@ chatCommandP =
|
||||
groupDomain <- optional (" domain=" *> (StrJSON <$> strP))
|
||||
domainWebPage <- (" domain_page=" *> onOffP) <|> pure False
|
||||
allowEmbedding <- (" embed=" *> onOffP) <|> pure False
|
||||
pure PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding}
|
||||
pure PublicGroupAccess {groupWebPage, groupDomain, groupDomainProof = Nothing, domainWebPage, allowEmbedding}
|
||||
profileNameDescr = (,) <$> displayNameP <*> shortDescrP
|
||||
-- 'Help with bot':'link <ID>','Menu of commands':[...]
|
||||
botCommandsP :: Parser [ChatBotCommand]
|
||||
@@ -5689,7 +5769,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, contactDomain = Nothing}
|
||||
let profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing, contactDomainProof = Nothing}
|
||||
pure NewUser {profile, pastTimestamp = False, userChatRelay = BoolDef relay, clientService = BoolDef service}
|
||||
newBotUserP = do
|
||||
files_ <- optional $ "files=" *> onOffP <* A.space
|
||||
@@ -5698,7 +5778,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, contactDomain = Nothing}
|
||||
profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences, badge = Nothing, contactDomain = Nothing, contactDomainProof = Nothing}
|
||||
pure NewUser {profile, pastTimestamp = False, userChatRelay = BoolDef False, clientService = BoolDef service}
|
||||
jsonP :: J.FromJSON a => Parser a
|
||||
jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
|
||||
|
||||
@@ -53,7 +53,7 @@ import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Time (addUTCTime)
|
||||
import Data.Time.Calendar (fromGregorian)
|
||||
import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds, secondsToDiffTime)
|
||||
import Simplex.Chat.Badges (BadgeCredential (..), ProofPresHeader (..), BadgeProof (..), BadgeStatus (..), LocalBadge (..), badgeProof, mkBadgeStatus, verifyBadge)
|
||||
import Simplex.Chat.Badges (BadgeCredential (..), ProofPresHeader (..), BadgeProof (..), BadgeStatus (..), LocalBadge (..), badgeProof, mkBadgeStatus, signNameProof, verifyBadge)
|
||||
import Simplex.Chat.Call
|
||||
import Simplex.Chat.Controller
|
||||
import Simplex.Chat.Files
|
||||
@@ -1223,13 +1223,14 @@ introduceInChannel cxt user gInfo subscriber@GroupMember {activeConn = Just conn
|
||||
sendGroupMemberMessages user gInfo conn evts
|
||||
|
||||
userProfileInGroup :: User -> GroupInfo -> Maybe Profile -> Profile
|
||||
userProfileInGroup user = userProfileInGroup' user . groupUserAllowSimplexLinks
|
||||
userProfileInGroup user g = userProfileInGroup' user (Just g)
|
||||
{-# INLINE userProfileInGroup #-}
|
||||
|
||||
userProfileInGroup' :: User -> Bool -> Maybe Profile -> Profile
|
||||
userProfileInGroup' User {profile = p} allowSimplexLinks incognitoProfile =
|
||||
-- Nothing group ⇒ no redaction (e.g. joining via a link with no group profile yet).
|
||||
userProfileInGroup' :: User -> Maybe GroupInfo -> Maybe Profile -> Profile
|
||||
userProfileInGroup' User {profile = p} mg incognitoProfile =
|
||||
let p' = fromMaybe (fromLocalProfile p) incognitoProfile
|
||||
in redactedMemberProfile allowSimplexLinks p'
|
||||
in maybe p' (\g -> redactedMemberProfile g (membership g) p') mg
|
||||
|
||||
memberInfo :: GroupInfo -> GroupMember -> MemberInfo
|
||||
memberInfo g m@GroupMember {memberId, memberRole, memberProfile, memberPubKey, activeConn} =
|
||||
@@ -1237,16 +1238,16 @@ memberInfo g m@GroupMember {memberId, memberRole, memberProfile, memberPubKey, a
|
||||
{ memberId,
|
||||
memberRole,
|
||||
v = ChatVersionRange . peerChatVRange <$> activeConn,
|
||||
profile = redactedMemberProfile allowSimplexLinks $ fromLocalProfile memberProfile,
|
||||
profile = redactedMemberProfile g m $ fromLocalProfile memberProfile,
|
||||
memberKey = MemberKey <$> memberPubKey
|
||||
}
|
||||
where
|
||||
allowSimplexLinks = groupFeatureMemberAllowed SGFSimplexLinks m g && groupFeatureMemberAllowed SGFDirectMessages m g
|
||||
|
||||
redactedMemberProfile :: Bool -> Profile -> Profile
|
||||
redactedMemberProfile allowSimplexLinks Profile {displayName, fullName, shortDescr, image, peerType, badge, contactDomain} =
|
||||
Profile {displayName, fullName, shortDescr = removeSimplexLink =<< shortDescr, image, contactLink = Nothing, preferences = Nothing, peerType, badge, contactDomain}
|
||||
redactedMemberProfile :: GroupInfo -> GroupMember -> Profile -> Profile
|
||||
redactedMemberProfile g m Profile {displayName, fullName, shortDescr, image, contactLink, peerType, badge, contactDomain} =
|
||||
Profile {displayName, fullName, shortDescr = removeSimplexLink =<< shortDescr, image, contactLink = if allowSimplexLinks then contactLink else Nothing, preferences = Nothing, peerType, badge, contactDomain = if allowDirect then contactDomain else Nothing, contactDomainProof = Nothing}
|
||||
where
|
||||
allowDirect = groupFeatureMemberAllowed SGFDirectMessages m g
|
||||
allowSimplexLinks = groupFeatureMemberAllowed SGFSimplexLinks m g && allowDirect
|
||||
removeSimplexLink s
|
||||
| allowSimplexLinks = Just s
|
||||
| hasObfuscatedSimplexLink s = Nothing
|
||||
@@ -2050,6 +2051,14 @@ presentUserBadge User {profile = LocalProfile {localBadge}} incognitoProfile p =
|
||||
Left e -> p <$ logError ("presentUserBadge: proof generation failed: " <> T.pack e)
|
||||
_ -> pure p
|
||||
|
||||
-- Add the user's name-claim proof to an outgoing address/invite profile: sign (name, link context)
|
||||
-- with the address root key (linkOwnerId = Nothing — the sole-owner contact-address case), bound to
|
||||
-- the link the profile is saved to. No-op without a name, key, or link.
|
||||
signAddressNameProof :: Maybe AConnShortLink -> Maybe C.PrivateKeyEd25519 -> Maybe SimplexNameInfo -> Profile -> Profile
|
||||
signAddressNameProof (Just lnk) (Just rootKey) (Just name) p =
|
||||
p {contactDomainProof = Just $ signNameProof rootKey Nothing name (PHSimplexLink lnk)}
|
||||
signAddressNameProof _ _ _ p = p
|
||||
|
||||
-- receiving side of contact/invitation link data: verify the badge proof from the link profile
|
||||
-- and set the crypto-free display badge for the UI (the raw proof stays in profile for APIPrepareContact)
|
||||
linkDataBadge :: ContactShortLinkData -> CM ContactShortLinkData
|
||||
@@ -2349,9 +2358,8 @@ sendGroupMessages user gInfo scope asGroup members events = do
|
||||
_ -> False
|
||||
sendProfileUpdate = do
|
||||
let members' = filter (`supportsVersion` memberProfileUpdateVersion) members
|
||||
allowSimplexLinks = groupUserAllowSimplexLinks gInfo
|
||||
-- shouldSendProfileUpdate excludes incognito membership, so the badge is presented
|
||||
profileUpdate <- presentUserBadge user Nothing $ redactedMemberProfile allowSimplexLinks $ fromLocalProfile p
|
||||
profileUpdate <- presentUserBadge user Nothing $ redactedMemberProfile gInfo (membership gInfo) $ fromLocalProfile p
|
||||
void $ sendGroupMessage' user gInfo members' $ XInfo profileUpdate
|
||||
currentTs <- liftIO getCurrentTime
|
||||
withStore' $ \db -> updateUserMemberProfileSentAt db user gInfo currentTs
|
||||
@@ -3092,7 +3100,8 @@ simplexTeamContactProfile =
|
||||
contactDomain = Nothing,
|
||||
peerType = Nothing,
|
||||
preferences = Nothing,
|
||||
badge = Nothing
|
||||
badge = Nothing,
|
||||
contactDomainProof = Nothing
|
||||
}
|
||||
|
||||
simplexStatusContactProfile :: Profile
|
||||
@@ -3106,7 +3115,8 @@ simplexStatusContactProfile =
|
||||
contactDomain = Nothing,
|
||||
peerType = Just CPTBot,
|
||||
preferences = Nothing,
|
||||
badge = Nothing
|
||||
badge = Nothing,
|
||||
contactDomainProof = Nothing
|
||||
}
|
||||
|
||||
timeItToView :: String -> CM' a -> CM' a
|
||||
|
||||
@@ -839,8 +839,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
XGrpMemInfo memId _memProfile
|
||||
| sameMemberId memId m -> do
|
||||
let GroupMember {memberId = membershipMemId} = membership
|
||||
allowSimplexLinks = groupUserAllowSimplexLinks gInfo
|
||||
membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile allowSimplexLinks $ fromLocalProfile $ memberProfile membership
|
||||
membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
|
||||
-- TODO update member profile
|
||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
allowAgentConnectionAsync user conn' confId $ XGrpMemInfo membershipMemId membershipProfile
|
||||
@@ -2813,8 +2812,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
| otherwise =
|
||||
pure m
|
||||
where
|
||||
contentChanged = not (sameProfileContent (redactedMemberProfile allowSimplexLinks (fromLocalProfile p)) (redactedMemberProfile allowSimplexLinks p'))
|
||||
allowSimplexLinks = groupFeatureMemberAllowed SGFSimplexLinks m gInfo && groupFeatureMemberAllowed SGFDirectMessages m gInfo
|
||||
contentChanged = not (sameProfileContent (redactedMemberProfile gInfo m (fromLocalProfile p)) (redactedMemberProfile gInfo m p'))
|
||||
updateBusinessChatProfile g@GroupInfo {businessChat} = case businessChat of
|
||||
Just bc | isMainBusinessMember bc m -> do
|
||||
g' <- withStore $ \db -> updateGroupProfileFromMember db user g p'
|
||||
@@ -3229,8 +3227,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
pure toMember
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
-- [incognito] send membership incognito profile, create direct connection as incognito
|
||||
let allowSimplexLinks = groupUserAllowSimplexLinks gInfo
|
||||
membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile allowSimplexLinks $ fromLocalProfile $ memberProfile membership
|
||||
membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
|
||||
dm <- encodeConnInfo $ XGrpMemInfo membershipMemId membershipProfile
|
||||
-- [async agent commands] no continuation needed, but commands should be asynchronous for stability
|
||||
groupConnIds <- joinAgentConnectionAsync user Nothing (chatHasNtfs chatSettings) groupConnReq dm subMode
|
||||
|
||||
@@ -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, contactDomain = Nothing}
|
||||
pure $ Profile {displayName = adjective <> noun, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing, contactDomainProof = Nothing}
|
||||
where
|
||||
pick :: [a] -> IO a
|
||||
pick xs = (xs !!) <$> randomRIO (0, length xs - 1)
|
||||
|
||||
@@ -117,15 +117,15 @@ 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,
|
||||
p.contact_domain, p.contact_domain_verification
|
||||
p.contact_domain, p.contact_domain_verification, p.contact_domain_proof
|
||||
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 :. (cpContactDomain, cpContactDomainVerification)) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = cpContactDomain, contactDomainVerification = unBI <$> cpContactDomainVerification, 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, cpContactDomainProof)) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = cpContactDomain, contactDomainVerification = unBI <$> cpContactDomainVerification, contactDomainProof = cpContactDomainProof, 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
|
||||
@@ -145,7 +145,7 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.short_descr, g.local_alias, 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.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding, gp.group_domain_proof,
|
||||
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
|
||||
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
|
||||
@@ -159,13 +159,13 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
|
||||
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.contact_domain, pu.contact_domain_verification,
|
||||
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, pu.contact_domain_proof,
|
||||
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.contact_domain, p.contact_domain_verification,
|
||||
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, p.contact_domain_proof,
|
||||
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
|
||||
|
||||
@@ -116,7 +116,7 @@ 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, cp.contact_domain, cp.contact_domain_verification,
|
||||
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, cp.contact_domain_proof,
|
||||
-- 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,
|
||||
@@ -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.contact_domain, p.contact_domain_verification
|
||||
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, p.contact_domain_proof
|
||||
FROM contact_requests cr
|
||||
JOIN contact_profiles p USING (contact_profile_id)
|
||||
WHERE cr.user_id = ?
|
||||
|
||||
@@ -325,7 +325,7 @@ 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,
|
||||
cp.contact_domain, cp.contact_domain_verification,
|
||||
cp.contact_domain, cp.contact_domain_verification, cp.contact_domain_proof,
|
||||
-- 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,
|
||||
@@ -570,24 +570,27 @@ updateContactProfile db cxt user@User {userId} c p' = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) lp p'
|
||||
let nameVerified = if claimChanged then Nothing else prevVerification
|
||||
profile = toLocalProfile profileId p' localAlias currentTs badgeVerified nameVerified
|
||||
profile = toLocalProfile profileId p'' localAlias currentTs badgeVerified nameVerified
|
||||
updateContactProfile' currentTs badgeVerified profile
|
||||
where
|
||||
Contact {contactId, localDisplayName, profile = lp@LocalProfile {profileId, displayName, localAlias, contactDomain = prevClaim, contactDomainVerification = prevVerification}, userPreferences} = c
|
||||
Contact {contactId, localDisplayName, profile = lp@LocalProfile {profileId, displayName, localAlias, contactDomain = prevClaim, contactDomainVerification = prevVerification, contactDomainProof = prevProof}, userPreferences} = c
|
||||
Profile {displayName = newName, contactDomain = profileContactDomain, preferences} = p'
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ contactConnIncognito c
|
||||
claimChanged = prevClaim /= ((\(StrJSON n) -> n) <$> profileContactDomain)
|
||||
-- a name proof never rides an XInfo peer-send (we never mint 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 $
|
||||
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 $ updateContactProfile_' db userId profileId p' badgeVerified currentTs
|
||||
liftIO $ updateContactProfile_' db userId profileId p'' badgeVerified currentTs
|
||||
liftIO clearVerificationIfClaimChanged
|
||||
pure c {profile, mergedPreferences}
|
||||
| otherwise =
|
||||
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
|
||||
updateContactProfile_' db userId profileId p' badgeVerified currentTs
|
||||
updateContactProfile_' db userId profileId p'' badgeVerified currentTs
|
||||
updateContactLDN_ db user contactId localDisplayName ldn currentTs
|
||||
clearVerificationIfClaimChanged
|
||||
pure $ Right c {localDisplayName = ldn, profile, mergedPreferences}
|
||||
@@ -735,17 +738,18 @@ 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, contactDomain, preferences, peerType, badge} badgeVerified updatedAt =
|
||||
updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainProof, 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 = ?,
|
||||
contact_domain = ?
|
||||
contact_domain = ?,
|
||||
contact_domain_proof = ?
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
|]
|
||||
((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. badgeToRow badge badgeVerified :. Only ((\(StrJSON n) -> n) <$> contactDomain) :. (userId, profileId))
|
||||
((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. badgeToRow badge badgeVerified :. (((\(StrJSON n) -> n) <$> contactDomain), contactDomainProof) :. (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 ()
|
||||
@@ -754,17 +758,18 @@ 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, contactDomain, badge} badgeVerified updatedAt =
|
||||
updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactDomain, contactDomainProof, 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 = ?,
|
||||
contact_domain = ?
|
||||
contact_domain = ?,
|
||||
contact_domain_proof = ?
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
|]
|
||||
((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. Only ((\(StrJSON n) -> n) <$> contactDomain) :. (userId, profileId))
|
||||
((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. (((\(StrJSON n) -> n) <$> contactDomain), contactDomainProof) :. (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 ()
|
||||
@@ -773,17 +778,18 @@ 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, contactDomain, badge} badgeVerified updatedAt =
|
||||
updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactDomain, contactDomainProof, 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 = ?,
|
||||
contact_domain = ?
|
||||
contact_domain = ?,
|
||||
contact_domain_proof = ?
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
|]
|
||||
((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. Only ((\(StrJSON n) -> n) <$> contactDomain) :. (userId, profileId))
|
||||
((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. (((\(StrJSON n) -> n) <$> contactDomain), contactDomainProof) :. (userId, profileId))
|
||||
|
||||
updateContactLDN_ :: DB.Connection -> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
|
||||
updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt = do
|
||||
@@ -860,7 +866,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.contact_domain, p.contact_domain_verification
|
||||
p.contact_domain, p.contact_domain_verification, p.contact_domain_proof
|
||||
FROM contact_requests cr
|
||||
JOIN contact_profiles p USING (contact_profile_id)
|
||||
|]
|
||||
@@ -981,7 +987,7 @@ 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,
|
||||
cp.contact_domain, cp.contact_domain_verification,
|
||||
cp.contact_domain, cp.contact_domain_verification, cp.contact_domain_proof,
|
||||
-- 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,
|
||||
|
||||
@@ -222,7 +222,7 @@ import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Clock (NominalDiffTime, UTCTime (..), addUTCTime, getCurrentTime)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Simplex.Chat.Badges (BadgeRow, badgeToRow, verifyBadge_)
|
||||
import Simplex.Chat.Badges (BadgeRow, ClaimProof, badgeToRow, verifyBadge_)
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Operators
|
||||
import Simplex.Chat.Protocol hiding (Binary)
|
||||
@@ -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 :. (Maybe SimplexNameInfo, Maybe BoolInt)) :. (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 ClaimProof)) :. (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 :. (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 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, profileContactDomainProof)) :. (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, profileContactDomainProof)) :. (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
|
||||
@@ -399,9 +399,9 @@ createNewGroup db cxt user@User {userId} groupProfile incognitoProfile useRelays
|
||||
INSERT INTO group_profiles
|
||||
(display_name, full_name, short_descr, description, image,
|
||||
group_type, group_link, public_group_id,
|
||||
group_web_page, group_domain, domain_web_page, allow_embedding,
|
||||
group_web_page, group_domain, domain_web_page, allow_embedding, group_domain_proof,
|
||||
user_id, preferences, member_admission, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. publicGroupAccessRow publicGroup
|
||||
:. (userId, groupPreferences, memberAdmission, currentTs, currentTs))
|
||||
@@ -905,9 +905,9 @@ createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus p
|
||||
INSERT INTO group_profiles
|
||||
(display_name, full_name, short_descr, description, image,
|
||||
group_type, group_link, public_group_id,
|
||||
group_web_page, group_domain, domain_web_page, allow_embedding,
|
||||
group_web_page, group_domain, domain_web_page, allow_embedding, group_domain_proof,
|
||||
user_id, preferences, member_admission, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. publicGroupAccessRow publicGroup
|
||||
:. (userId, groupPreferences, memberAdmission, currentTs, currentTs))
|
||||
@@ -1956,7 +1956,7 @@ getRelayPublishableGroups db User {userId, userContactId} =
|
||||
db
|
||||
[sql|
|
||||
SELECT g.group_id, gp.public_group_id,
|
||||
gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding
|
||||
gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding, gp.group_domain_proof
|
||||
FROM groups g
|
||||
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
|
||||
JOIN group_members mu ON mu.group_id = g.group_id AND mu.contact_id = ?
|
||||
@@ -2682,7 +2682,7 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
|
||||
UPDATE group_profiles
|
||||
SET display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?,
|
||||
group_type = ?, group_link = ?,
|
||||
group_web_page = ?, group_domain = ?, domain_web_page = ?, allow_embedding = ?,
|
||||
group_web_page = ?, group_domain = ?, domain_web_page = ?, allow_embedding = ?, group_domain_proof = ?,
|
||||
preferences = ?, member_admission = ?, updated_at = ?
|
||||
WHERE group_profile_id IN (
|
||||
SELECT group_profile_id
|
||||
@@ -2738,7 +2738,7 @@ updateGroupProfileFromMember db user g@GroupInfo {groupId} Profile {displayName
|
||||
[sql|
|
||||
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.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding, gp.group_domain_proof,
|
||||
gp.preferences, gp.member_admission
|
||||
FROM group_profiles gp
|
||||
JOIN groups g ON gp.group_profile_id = g.group_profile_id
|
||||
|
||||
@@ -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.contact_domain, p.contact_domain_verification,
|
||||
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, p.contact_domain_proof,
|
||||
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.contact_domain, p.contact_domain_verification
|
||||
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, p.contact_domain_proof
|
||||
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.contact_domain, p.contact_domain_verification,
|
||||
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, p.contact_domain_proof,
|
||||
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.contact_domain, rp.contact_domain_verification,
|
||||
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, rp.contact_domain_proof,
|
||||
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.contact_domain, dbp.contact_domain_verification,
|
||||
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, dbp.contact_domain_proof,
|
||||
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
|
||||
|
||||
@@ -15,6 +15,10 @@ import Text.RawString.QQ (r)
|
||||
-- are the local 3-state verification status (NULL = not attempted, 0 = failed,
|
||||
-- 1 = verified), reset to NULL when the claimed name changes.
|
||||
--
|
||||
-- contact_profiles.contact_domain_proof holds the peer's name ClaimProof (JSON).
|
||||
-- user_contact_links.link_priv_sig_key is the contact-address owner signing key
|
||||
-- (captured at short-link creation) used to sign the user's own name proofs.
|
||||
--
|
||||
-- server_operators.smp_role_names enables name resolution for an operator's SMP
|
||||
-- servers (set for the simplex operator).
|
||||
m20260603_simplex_name :: Text
|
||||
@@ -22,7 +26,10 @@ m20260603_simplex_name =
|
||||
[r|
|
||||
ALTER TABLE contact_profiles ADD COLUMN contact_domain TEXT;
|
||||
ALTER TABLE contact_profiles ADD COLUMN contact_domain_verification SMALLINT;
|
||||
ALTER TABLE contact_profiles ADD COLUMN contact_domain_proof TEXT;
|
||||
ALTER TABLE groups ADD COLUMN group_domain_verification SMALLINT;
|
||||
ALTER TABLE group_profiles ADD COLUMN group_domain_proof TEXT;
|
||||
ALTER TABLE user_contact_links ADD COLUMN link_priv_sig_key BYTEA;
|
||||
|
||||
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';
|
||||
@@ -33,7 +40,10 @@ down_m20260603_simplex_name =
|
||||
[r|
|
||||
ALTER TABLE server_operators DROP COLUMN smp_role_names;
|
||||
|
||||
ALTER TABLE user_contact_links DROP COLUMN link_priv_sig_key;
|
||||
ALTER TABLE group_profiles DROP COLUMN group_domain_proof;
|
||||
ALTER TABLE groups DROP COLUMN group_domain_verification;
|
||||
ALTER TABLE contact_profiles DROP COLUMN contact_domain_proof;
|
||||
ALTER TABLE contact_profiles DROP COLUMN contact_domain_verification;
|
||||
ALTER TABLE contact_profiles DROP COLUMN contact_domain;
|
||||
|]
|
||||
|
||||
@@ -50,6 +50,8 @@ module Simplex.Chat.Store.Profiles
|
||||
getUserAddressConnection,
|
||||
deleteUserAddress,
|
||||
getUserAddress,
|
||||
getUserAddressSigKey,
|
||||
setUserSimplexName,
|
||||
getUserContactLinkById,
|
||||
getGroupLinkInfo,
|
||||
getUserContactLinkByConnReq,
|
||||
@@ -161,7 +163,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 :. (Nothing, 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, Nothing)
|
||||
|
||||
-- TODO [mentions]
|
||||
getUsersInfo :: DB.Connection -> IO [UserInfo]
|
||||
@@ -387,6 +389,17 @@ 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
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE contact_profiles SET contact_domain = ?, updated_at = ? WHERE user_id = ? AND contact_profile_id = ?"
|
||||
(name_, ts, userId, profileId)
|
||||
pure (user :: User) {profile = p {contactDomain = name_}}
|
||||
|
||||
setUserProfileContactLink :: DB.Connection -> User -> Maybe UserContactLink -> IO User
|
||||
setUserProfileContactLink db user@User {userId, profile = p@LocalProfile {profileId}} ucl_ = do
|
||||
ts <- getCurrentTime
|
||||
@@ -416,17 +429,17 @@ getUserContactProfiles db User {userId} =
|
||||
(Only userId)
|
||||
where
|
||||
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}
|
||||
toContactProfile (displayName, fullName, shortDescr, image, contactLink, peerType, contactDomainRaw, preferences) = Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain = StrJSON <$> contactDomainRaw, peerType, preferences, badge = Nothing, contactDomainProof = Nothing}
|
||||
|
||||
createUserContactLink :: DB.Connection -> User -> ConnId -> CreatedLinkContact -> SubscriptionMode -> ExceptT StoreError IO ()
|
||||
createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMode =
|
||||
createUserContactLink :: DB.Connection -> User -> ConnId -> CreatedLinkContact -> SubscriptionMode -> C.PrivateKeyEd25519 -> ExceptT StoreError IO ()
|
||||
createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMode linkPrivSigKey =
|
||||
checkConstraint SEDuplicateContactLink . liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
let slDataSet = BI (isJust shortLink)
|
||||
DB.execute
|
||||
db
|
||||
"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)
|
||||
"INSERT INTO user_contact_links (user_id, conn_req_contact, short_link_contact, short_link_data_set, short_link_large_data_set, link_priv_sig_key, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(userId, cReq, shortLink, slDataSet, slDataSet, linkPrivSigKey, currentTs, currentTs)
|
||||
userContactLinkId <- insertedRowId db
|
||||
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff
|
||||
|
||||
@@ -515,6 +528,12 @@ 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 $
|
||||
DB.query db "SELECT link_priv_sig_key FROM user_contact_links WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL" (Only userId)
|
||||
|
||||
getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO (UserContactLink, Maybe GroupLinkInfo)
|
||||
getUserContactLinkById db userId userContactLinkId =
|
||||
ExceptT . firstRow (\(ucl :. gli) -> (toUserContactLink ucl, toGroupLinkInfo gli)) SEUserContactLinkNotFound $
|
||||
|
||||
@@ -14,6 +14,10 @@ import Database.SQLite.Simple.QQ (sql)
|
||||
-- are the local 3-state verification status (NULL = not attempted, 0 = failed,
|
||||
-- 1 = verified), reset to NULL when the claimed name changes.
|
||||
--
|
||||
-- contact_profiles.contact_domain_proof holds the peer's name ClaimProof (JSON).
|
||||
-- user_contact_links.link_priv_sig_key is the contact-address owner signing key
|
||||
-- (captured at short-link creation) used to sign the user's own name proofs.
|
||||
--
|
||||
-- server_operators.smp_role_names enables name resolution for an operator's SMP
|
||||
-- servers (set for the simplex operator).
|
||||
m20260603_simplex_name :: Query
|
||||
@@ -21,7 +25,10 @@ m20260603_simplex_name =
|
||||
[sql|
|
||||
ALTER TABLE contact_profiles ADD COLUMN contact_domain TEXT;
|
||||
ALTER TABLE contact_profiles ADD COLUMN contact_domain_verification INTEGER;
|
||||
ALTER TABLE contact_profiles ADD COLUMN contact_domain_proof TEXT;
|
||||
ALTER TABLE groups ADD COLUMN group_domain_verification INTEGER;
|
||||
ALTER TABLE group_profiles ADD COLUMN group_domain_proof TEXT;
|
||||
ALTER TABLE user_contact_links ADD COLUMN link_priv_sig_key BLOB;
|
||||
|
||||
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';
|
||||
@@ -32,7 +39,10 @@ down_m20260603_simplex_name =
|
||||
[sql|
|
||||
ALTER TABLE server_operators DROP COLUMN smp_role_names;
|
||||
|
||||
ALTER TABLE user_contact_links DROP COLUMN link_priv_sig_key;
|
||||
ALTER TABLE group_profiles DROP COLUMN group_domain_proof;
|
||||
ALTER TABLE groups DROP COLUMN group_domain_verification;
|
||||
ALTER TABLE contact_profiles DROP COLUMN contact_domain_proof;
|
||||
ALTER TABLE contact_profiles DROP COLUMN contact_domain_verification;
|
||||
ALTER TABLE contact_profiles DROP COLUMN contact_domain;
|
||||
|]
|
||||
|
||||
@@ -33,7 +33,7 @@ import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime (..), getCurrentTime)
|
||||
import Data.Type.Equality
|
||||
import Simplex.Chat.Badges (BadgeRow, badgeToRow, rowToBadge, verifyBadge_)
|
||||
import Simplex.Chat.Badges (BadgeRow, ClaimProof, badgeToRow, rowToBadge, verifyBadge_)
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Remote.Types
|
||||
import Simplex.Chat.Types
|
||||
@@ -418,13 +418,13 @@ createContact db cxt user profile = do
|
||||
|
||||
-- | 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 =
|
||||
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
|
||||
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, contact_domain) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified :. Only ((\(StrJSON n) -> n) <$> contactDomain))
|
||||
"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, contact_domain_proof) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified :. (((\(StrJSON n) -> n) <$> contactDomain), contactDomainProof))
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
@@ -491,15 +491,15 @@ 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 SimplexNameInfo, Maybe 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 SimplexNameInfo, Maybe BoolInt, Maybe ClaimProof)
|
||||
|
||||
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)) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = cpContactDomain, contactDomainVerification = unBI <$> cpContactDomainVerification, 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, 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}
|
||||
activeConn = toMaybeConnection cxt connRow
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
|
||||
incognito = maybe False connIncognito activeConn
|
||||
@@ -532,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.contact_domain, cp.contact_domain_verification
|
||||
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, cp.contact_domain_proof
|
||||
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 :. (Maybe SimplexNameInfo, Maybe BoolInt)
|
||||
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, Maybe ClaimProof)
|
||||
|
||||
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 :. (contactDomain, contactDomainVerification)) = do
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, 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, contactDomainProof)) = do
|
||||
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, contactDomainProof, 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}
|
||||
|
||||
@@ -551,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, ucp.contact_domain, ucp.contact_domain_verification
|
||||
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, ucp.contact_domain_proof
|
||||
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 :. (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)) =
|
||||
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, Maybe ClaimProof) -> 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, contactDomainProof)) =
|
||||
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, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, peerType, localBadge = rowToBadge now badgeRow, preferences = userPreferences, localAlias = ""}
|
||||
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, contactDomainProof, peerType, localBadge = rowToBadge now badgeRow, preferences = userPreferences, localAlias = ""}
|
||||
fullPreferences = fullPreferences' userPreferences
|
||||
viewPwdHash = UserPwdHash <$> viewPwdHash_ <*> viewPwdSalt_
|
||||
|
||||
@@ -679,11 +679,11 @@ type GroupKeysRow = (Maybe C.PrivateKeyEd25519, Maybe C.PublicKeyEd25519, Maybe
|
||||
|
||||
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 SimplexNameInfo, Maybe BoolInt, Maybe BoolInt)
|
||||
type PublicGroupAccessRow = (Maybe Text, Maybe SimplexNameInfo, Maybe BoolInt, Maybe BoolInt, Maybe ClaimProof)
|
||||
|
||||
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 :. (Maybe SimplexNameInfo, Maybe BoolInt)
|
||||
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences) :. BadgeRow :. (Maybe SimplexNameInfo, Maybe BoolInt, Maybe ClaimProof)
|
||||
|
||||
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 :. Only groupDomainVerification :. userMemberRow) =
|
||||
@@ -711,14 +711,14 @@ toPublicGroupProfile _ _ _ _ = Nothing
|
||||
|
||||
publicGroupAccessRow :: Maybe PublicGroupProfile -> PublicGroupAccessRow
|
||||
publicGroupAccessRow pgp = case pgp >>= publicGroupAccess of
|
||||
Just PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding} ->
|
||||
(groupWebPage, (\(StrJSON n) -> n) <$> groupDomain, Just (BI domainWebPage), Just (BI allowEmbedding))
|
||||
Nothing -> (Nothing, Nothing, Nothing, Nothing)
|
||||
Just PublicGroupAccess {groupWebPage, groupDomain, groupDomainProof, domainWebPage, allowEmbedding} ->
|
||||
(groupWebPage, (\(StrJSON n) -> n) <$> groupDomain, Just (BI domainWebPage), Just (BI allowEmbedding), groupDomainProof)
|
||||
Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
|
||||
toPublicGroupAccess :: PublicGroupAccessRow -> Maybe PublicGroupAccess
|
||||
toPublicGroupAccess (groupWebPage, groupDomain, domainWebPage_, allowEmbedding_)
|
||||
toPublicGroupAccess (groupWebPage, groupDomain, domainWebPage_, allowEmbedding_, groupDomainProof)
|
||||
| isJust groupWebPage || isJust groupDomain || domainWebPage || allowEmbedding =
|
||||
Just PublicGroupAccess {groupWebPage, groupDomain = StrJSON <$> groupDomain, domainWebPage, allowEmbedding}
|
||||
Just PublicGroupAccess {groupWebPage, groupDomain = StrJSON <$> groupDomain, groupDomainProof, domainWebPage, allowEmbedding}
|
||||
| otherwise = Nothing
|
||||
where
|
||||
domainWebPage = maybe False unBI domainWebPage_
|
||||
@@ -757,7 +757,7 @@ 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.contact_domain, p.contact_domain_verification,
|
||||
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, p.contact_domain_proof,
|
||||
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,
|
||||
@@ -774,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 :. (contactDomain, contactDomainVerification)) =
|
||||
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, peerType, localBadge = rowToBadge now badgeRow, localAlias, preferences}
|
||||
rowToLocalProfile now ((profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences) :. badgeRow :. (contactDomain, contactDomainVerification, contactDomainProof)) =
|
||||
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, contactDomainProof, peerType, localBadge = rowToBadge now badgeRow, localAlias, preferences}
|
||||
|
||||
toBusinessChatInfo :: BusinessChatInfoRow -> Maybe BusinessChatInfo
|
||||
toBusinessChatInfo (Just chatType, Just businessId, Just customerId) = Just BusinessChatInfo {chatType, businessId, customerId}
|
||||
@@ -791,7 +791,7 @@ groupInfoQueryFields =
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.short_descr, g.local_alias, 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.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding, gp.group_domain_proof,
|
||||
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
|
||||
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
|
||||
@@ -804,7 +804,7 @@ groupInfoQueryFields =
|
||||
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.contact_domain, pu.contact_domain_verification,
|
||||
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, pu.contact_domain_proof,
|
||||
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
|
||||
|]
|
||||
|
||||
+12
-14
@@ -48,7 +48,7 @@ import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Word (Word16)
|
||||
import Simplex.Chat.Badges (BadgeInfo (..), BadgeProof (..), BadgeStatus (..), LocalBadge (..), localBadgeInfo, localBadgeStatus, mkBadgeStatus, verifyBadge)
|
||||
import Simplex.Chat.Badges (BadgeInfo (..), BadgeProof (..), BadgeStatus (..), ClaimProof (..), LocalBadge (..), localBadgeInfo, localBadgeStatus, mkBadgeStatus, verifyBadge)
|
||||
import Simplex.Messaging.Crypto.BBS (BBSPublicKey)
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.Shared
|
||||
@@ -642,12 +642,6 @@ groupFeatureUserAllowed :: GroupFeatureRoleI f => SGroupFeature f -> GroupInfo -
|
||||
groupFeatureUserAllowed feature GroupInfo {membership = GroupMember {memberRole}, fullGroupPreferences} =
|
||||
groupFeatureMemberAllowed' feature memberRole fullGroupPreferences
|
||||
|
||||
-- A connection link in a profile description enables a direct connection, so a description
|
||||
-- keeps its links only when both SimpleX links and direct messages are allowed.
|
||||
groupUserAllowSimplexLinks :: GroupInfo -> Bool
|
||||
groupUserAllowSimplexLinks g =
|
||||
groupFeatureUserAllowed SGFSimplexLinks g && groupFeatureUserAllowed SGFDirectMessages g
|
||||
|
||||
mergeUserChatPrefs :: User -> Contact -> FullPreferences
|
||||
mergeUserChatPrefs user ct = mergeUserChatPrefs' user (contactConnIncognito ct) (userPreferences ct)
|
||||
|
||||
@@ -700,7 +694,8 @@ data Profile = Profile
|
||||
preferences :: Maybe Preferences,
|
||||
peerType :: Maybe ChatPeerType,
|
||||
badge :: Maybe BadgeProof,
|
||||
contactDomain :: Maybe (StrJSON "SimplexName" SimplexNameInfo)
|
||||
contactDomain :: Maybe (StrJSON "SimplexName" SimplexNameInfo),
|
||||
contactDomainProof :: Maybe ClaimProof
|
||||
-- fields that should not be read into this data type to prevent sending them as part of profile to contacts:
|
||||
-- - contact_profile_id
|
||||
-- - incognito
|
||||
@@ -733,7 +728,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, contactDomain = Nothing}
|
||||
Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing, peerType = Nothing, badge = Nothing, contactDomain = Nothing, contactDomainProof = Nothing}
|
||||
|
||||
-- check if profiles match ignoring preferences
|
||||
profilesMatch :: LocalProfile -> LocalProfile -> Bool
|
||||
@@ -746,7 +741,7 @@ profilesMatch
|
||||
-- so compare badges by disclosed info (not proof bytes) - a re-presentation of the same badge is a no-op
|
||||
sameProfileContent :: Profile -> Profile -> Bool
|
||||
sameProfileContent p@Profile {badge = b} p'@Profile {badge = b'} =
|
||||
p {badge = Nothing} == p' {badge = Nothing} && (proofInfo <$> b) == (proofInfo <$> b')
|
||||
p {badge = Nothing, contactDomainProof = Nothing} == p' {badge = Nothing, contactDomainProof = Nothing} && (proofInfo <$> b) == (proofInfo <$> b')
|
||||
where
|
||||
proofInfo :: BadgeProof -> BadgeInfo
|
||||
proofInfo (BadgeProof _ _ _ info) = info
|
||||
@@ -785,7 +780,8 @@ data LocalProfile = LocalProfile
|
||||
localBadge :: Maybe LocalBadge,
|
||||
localAlias :: LocalAlias,
|
||||
contactDomain :: Maybe SimplexNameInfo,
|
||||
contactDomainVerification :: Maybe Bool
|
||||
contactDomainVerification :: Maybe Bool,
|
||||
contactDomainProof :: Maybe ClaimProof
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -793,14 +789,15 @@ localProfileId :: LocalProfile -> ProfileId
|
||||
localProfileId LocalProfile {profileId} = profileId
|
||||
|
||||
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}
|
||||
toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge, contactDomain, contactDomainProof} localAlias now verified nameVerified =
|
||||
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, localAlias, contactDomain = (\(StrJSON n) -> n) <$> contactDomain, contactDomainVerification = nameVerified, contactDomainProof}
|
||||
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, contactDomain} =
|
||||
Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = localBadge >>= wireBadge, contactDomain = StrJSON <$> contactDomain}
|
||||
-- contactDomainProof is generated fresh at send (presentUserBadge) / dropped by redaction, never carried from the stored profile
|
||||
Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = localBadge >>= wireBadge, contactDomain = StrJSON <$> contactDomain, contactDomainProof = Nothing}
|
||||
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
|
||||
@@ -847,6 +844,7 @@ instance ToField GroupType where toField = toField . textEncode
|
||||
data PublicGroupAccess = PublicGroupAccess
|
||||
{ groupWebPage :: Maybe Text,
|
||||
groupDomain :: Maybe (StrJSON "SimplexName" SimplexNameInfo),
|
||||
groupDomainProof :: Maybe ClaimProof,
|
||||
domainWebPage :: Bool,
|
||||
allowEmbedding :: Bool
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user