mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-10-15 02:21:08 +00:00
core: badge presentations in profiles (#7573)
* badge presentation in groups * fix tests * badge presentations in profiles * update simplexmq * change types * badge profile presentations * improvements * remove proof from cards, send owner public key for channel to relay * add test * merge migrations * update * prevent fallback to PHTest * fixes * many fixes * fixes * fixes * cleanup * improve * query plans * fix test * diff --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
This commit is contained in:
Evgeny
co-authored by
Evgeny @ SimpleX Chat
Evgeny @ SimpleX Chat
parent
74c6b9d930
commit
2e56d32b52
+53
-19
@@ -47,13 +47,18 @@ module Simplex.Chat.Badges
|
||||
generateBadgeProof,
|
||||
badgeProof,
|
||||
verifyBadge,
|
||||
verifyBadge_,
|
||||
acceptedProof,
|
||||
acceptedBadge,
|
||||
sameBadgeProof,
|
||||
unboundProof,
|
||||
mkBadgeStatus,
|
||||
BadgeRow,
|
||||
BadgeProofKind (..),
|
||||
BadgeProofRow,
|
||||
badgeProofToRow,
|
||||
rowToBadgeProof,
|
||||
MaybeBadgeProofRow,
|
||||
maybeRowToBadgeProof,
|
||||
badgeToRow,
|
||||
localBadgeToRow,
|
||||
rowToBadge,
|
||||
@@ -76,7 +81,7 @@ import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, nominalDay)
|
||||
import Data.Time.Clock.System (systemToUTCTime, utcToSystemTime)
|
||||
import Simplex.FileTransfer.Description (gb, maxFileSize)
|
||||
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), fromTextField_)
|
||||
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), blobFieldDecoder, fromTextField_)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.BBS
|
||||
import Simplex.Messaging.Crypto.Entitlement (Entitlement (Entitlement), EntitlementCredential (EntitlementCredential), MasterKey (MasterKey), entitlementBBSHeader)
|
||||
@@ -267,10 +272,17 @@ maxSndXFTPFileSize lims now = \case
|
||||
_ -> noBadge lims
|
||||
|
||||
-- Presentation header: a tag char + payload. PHTest is unbound - a fresh random nonce per
|
||||
-- presentation, not bound to any context; the 'T' tag marks it so master rejects it.
|
||||
-- presentation, not bound to any context.
|
||||
-- PHUnknown is the forward-compat catch-all for tags this version does not interpret.
|
||||
|
||||
data ProofPresHeaderTag = PHTestTag | PHChatTag | PHFileInvTag | PHFileDescrTag | PHUnknownTag Char
|
||||
data ProofPresHeaderTag
|
||||
= PHTestTag -- random nonce: released clients
|
||||
| PHChatTag -- direct chat ratchet, group member key
|
||||
| PHFileInvTag -- file invitation
|
||||
| PHFileDescrTag -- file description
|
||||
| PHRequestTag -- request to address without ratchet keys
|
||||
| PHLinkTag -- invitation and address link data
|
||||
| PHUnknownTag Char -- tags of newer versions
|
||||
|
||||
instance StrEncoding ProofPresHeaderTag where
|
||||
strEncode = B.singleton . \case
|
||||
@@ -278,6 +290,8 @@ instance StrEncoding ProofPresHeaderTag where
|
||||
PHChatTag -> 'C'
|
||||
PHFileInvTag -> 'F'
|
||||
PHFileDescrTag -> 'D'
|
||||
PHRequestTag -> 'R'
|
||||
PHLinkTag -> 'L'
|
||||
PHUnknownTag c -> c
|
||||
strP = tag <$> A.anyChar
|
||||
where
|
||||
@@ -286,6 +300,8 @@ instance StrEncoding ProofPresHeaderTag where
|
||||
'C' -> PHChatTag
|
||||
'F' -> PHFileInvTag
|
||||
'D' -> PHFileDescrTag
|
||||
'R' -> PHRequestTag
|
||||
'L' -> PHLinkTag
|
||||
c -> PHUnknownTag c
|
||||
|
||||
data ProofPresHeader
|
||||
@@ -293,6 +309,8 @@ data ProofPresHeader
|
||||
| PHChat ByteString
|
||||
| PHFileInv {chatBinding :: ByteString, fileSize :: Int64}
|
||||
| PHFileDescr {chatBinding :: ByteString, fileSize :: Int64, descrHash :: ByteString, fileExpires :: Maybe UTCTime}
|
||||
| PHRequest ByteString
|
||||
| PHLink ByteString
|
||||
| PHUnknown Char ByteString
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -311,6 +329,8 @@ instance StrEncoding ProofPresHeader where
|
||||
strEncode PHFileInvTag <> smpEncode (chatBinding, fileSize)
|
||||
PHFileDescr {chatBinding, fileSize, descrHash, fileExpires} ->
|
||||
strEncode PHFileDescrTag <> smpEncode (chatBinding, fileSize, descrHash, utcToSystemTime <$> fileExpires)
|
||||
PHRequest code -> strEncode PHRequestTag <> code
|
||||
PHLink linkKey -> strEncode PHLinkTag <> linkKey
|
||||
PHUnknown c b -> strEncode (PHUnknownTag c) <> b
|
||||
strP =
|
||||
strP >>= \case
|
||||
@@ -322,16 +342,25 @@ instance StrEncoding ProofPresHeader where
|
||||
PHFileDescrTag -> do
|
||||
(chatBinding, fileSize, descrHash, expires_) <- smpP
|
||||
pure PHFileDescr {chatBinding, fileSize, descrHash, fileExpires = systemToUTCTime <$> expires_}
|
||||
PHRequestTag -> PHRequest <$> A.takeByteString
|
||||
PHLinkTag -> PHLink <$> A.takeByteString
|
||||
PHUnknownTag c -> PHUnknown c <$> A.takeByteString
|
||||
|
||||
-- v6.5.x accepts both; v7 will reject PHTest/PHUnknown
|
||||
proofPresHeaderAccepted :: ProofPresHeader -> Bool
|
||||
proofPresHeaderAccepted = \case
|
||||
PHTest _ -> True
|
||||
PHChat _ -> True
|
||||
PHFileInv {} -> True
|
||||
PHFileDescr {} -> True
|
||||
PHUnknown _ _ -> True
|
||||
acceptedProof :: Maybe ProofPresHeader -> BadgeProof -> Bool
|
||||
acceptedProof expected_ b@BadgeProof {presHeader = BBSPresHeader ph} = unboundProof b || any ((ph ==) . strEncode) expected_
|
||||
|
||||
acceptedBadge :: Maybe ProofPresHeader -> Maybe BadgeProof -> Maybe BadgeProof -> Maybe BadgeProof
|
||||
acceptedBadge expected_ stored_ received_ = if all (acceptedProof expected_) received_ then received_ else stored_
|
||||
|
||||
sameBadgeProof :: Maybe BadgeProof -> Maybe BadgeProof -> Bool
|
||||
sameBadgeProof b_ b_' = (proofContent <$> b_) == (proofContent <$> b_')
|
||||
where
|
||||
proofContent b@BadgeProof {presHeader, badgeInfo} = (if unboundProof b then Nothing else Just presHeader, badgeInfo)
|
||||
|
||||
unboundProof :: BadgeProof -> Bool
|
||||
unboundProof BadgeProof {presHeader = BBSPresHeader ph} = case strDecode ph of
|
||||
Right (PHTest _) -> True
|
||||
_ -> False
|
||||
|
||||
-- Payment proof
|
||||
|
||||
@@ -425,16 +454,15 @@ verifyBadge keys b@(BadgeProof keyIdx _ _ _) = case M.lookup keyIdx keys of
|
||||
Just pk -> Just <$> verifyBadgeWith pk b
|
||||
|
||||
verifyBadgeWith :: BBSPublicKey -> BadgeProof -> IO Bool
|
||||
verifyBadgeWith pk (BadgeProof _ ph@(BBSPresHeader phBytes) proof badgeInfo)
|
||||
| either (const False) proofPresHeaderAccepted (strDecode phBytes) =
|
||||
bbsProofVerify pk proof bbsBadgeHeader ph bbsBadgeDisclosedIndexes bbsBadgeMessageCount (badgeInfoMessages badgeInfo)
|
||||
| otherwise = pure False
|
||||
|
||||
verifyBadge_ :: Map Int BBSPublicKey -> Maybe BadgeProof -> IO (Maybe Bool)
|
||||
verifyBadge_ keys = maybe (pure (Just False)) (verifyBadge keys)
|
||||
verifyBadgeWith pk (BadgeProof _ ph proof badgeInfo) =
|
||||
bbsProofVerify pk proof bbsBadgeHeader ph bbsBadgeDisclosedIndexes bbsBadgeMessageCount (badgeInfoMessages badgeInfo)
|
||||
|
||||
-- DB
|
||||
|
||||
instance FromField ProofPresHeader where fromField = blobFieldDecoder strDecode
|
||||
|
||||
instance ToField ProofPresHeader where toField = toField . Binary . strEncode
|
||||
|
||||
instance FromField BadgeType where fromField = fromTextField_ textDecode
|
||||
|
||||
instance ToField BadgeType where toField = toField . textEncode
|
||||
@@ -459,6 +487,12 @@ rowToBadgeProof (Binary p, Binary ph, idx, type_, badgeExpiry, badgeExtra) = do
|
||||
badgeType <- textDecode type_
|
||||
pure $ BadgeProof idx (BBSPresHeader ph) (BBSProof p) BadgeInfo {badgeType, badgeExpiry, badgeExtra}
|
||||
|
||||
type MaybeBadgeProofRow = (Maybe (Binary ByteString), Maybe (Binary ByteString), Maybe Int, Maybe Text, Maybe UTCTime, Maybe Text)
|
||||
|
||||
maybeRowToBadgeProof :: MaybeBadgeProofRow -> Maybe BadgeProof
|
||||
maybeRowToBadgeProof (p_, ph_, idx_, type_, expiry_, extra_) =
|
||||
rowToBadgeProof =<< (,,,,,) <$> p_ <*> ph_ <*> idx_ <*> type_ <*> expiry_ <*> extra_
|
||||
|
||||
-- (proof, pres_header, expiry, type, verified, extra, master_key, signature, key_idx) - binary columns wrapped in Binary (BLOB/bytea)
|
||||
type BadgeRow = (Maybe (Binary ByteString), Maybe (Binary ByteString), Maybe UTCTime, Maybe Text, Maybe BoolInt, Maybe Text, Maybe (Binary ByteString), Maybe (Binary ByteString), Maybe Int)
|
||||
|
||||
|
||||
@@ -59,7 +59,7 @@ import qualified Data.UUID.V4 as V4
|
||||
import Simplex.Chat.Library.Subscriber
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Simplex.Messaging.Session (SessionVar (..), withGetSessVar')
|
||||
import Simplex.Chat.Badges (BadgeCredential (..), BadgeInfo (..), BadgeMasterKey, BadgeType, LocalBadge (..), badgeServerCredential, mkBadgeStatus, maxSndXFTPFileSize, verifyCredential)
|
||||
import Simplex.Chat.Badges (BadgeCredential (..), BadgeInfo (..), BadgeMasterKey, BadgeType, LocalBadge (..), ProofPresHeader (..), badgeServerCredential, mkBadgeStatus, maxSndXFTPFileSize, verifyCredential)
|
||||
import qualified Simplex.Chat.Badges.Ledger as L
|
||||
import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeAlertKind (..), BadgeIssueError (..), BadgeIssueFailure (..), BadgeState (..))
|
||||
import Simplex.Chat.Badges.Code (badgeCodeText, parseBadgeCode)
|
||||
@@ -2124,11 +2124,12 @@ processChatCommand cxt nm = \case
|
||||
-- [incognito] generate profile for connection
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
-- TODO [badges] bind link and badge to handshake context
|
||||
linkProfile <- presentUserBadge user incognitoProfile $ userProfileDirect user incognitoProfile Nothing True
|
||||
rootKey <- atomically . C.generateKeyPair =<< asks random
|
||||
(preparedLink, preparedParams@PreparedLinkParams {plpLinkKey = LinkKey linkKey}) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) SCMInvitation rootKey Nothing False Nothing IKUsePQ False Nothing
|
||||
linkProfile <- presentUserBadge user incognitoProfile (Just $ PHLink linkKey) $ userProfileDirect user incognitoProfile Nothing True
|
||||
let userData = contactShortLinkData linkProfile {contactDomain = Nothing} Nothing
|
||||
userLinkData = UserInvLinkData userData
|
||||
(connId, ccLink) <- withAgent $ \a -> createConnection a nm (aUserId user) True False SCMInvitation (Just userLinkData) Nothing IKUsePQ True subMode
|
||||
(connId, ccLink) <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True preparedLink preparedParams userLinkData subMode
|
||||
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
|
||||
@@ -2137,7 +2138,7 @@ processChatCommand cxt nm = \case
|
||||
processChatCommand cxt nm $ APIAddContact userId incognito
|
||||
APISetConnectionIncognito connId incognito -> withUser $ \user@User {userId} -> do
|
||||
conn <- withFastStore $ \db -> getPendingContactConnection db userId connId
|
||||
let PendingContactConnection {pccConnStatus, customUserProfileId} = conn
|
||||
let PendingContactConnection {pccConnStatus, customUserProfileId, connLinkInv} = conn
|
||||
case (pccConnStatus, customUserProfileId, incognito) of
|
||||
(ConnNew, Nothing, True) -> do
|
||||
incognitoProfile <- liftIO generateRandomProfile
|
||||
@@ -2147,7 +2148,7 @@ processChatCommand cxt nm = \case
|
||||
updatePCCIncognito db user conn (Just pId) sLnk
|
||||
pure $ CRConnectionIncognitoUpdated user conn' (Just incognitoProfile)
|
||||
(ConnNew, Just pId, False) -> do
|
||||
sLnk <- updatePCCShortLinkData conn =<< presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True)
|
||||
sLnk <- updatePCCShortLinkData conn =<< presentUserBadge user Nothing (linkPresHeader <$> (connShortLink' =<< connLinkInv)) (userProfileDirect user Nothing Nothing True)
|
||||
conn' <- withFastStore' $ \db -> do
|
||||
deletePCCIncognitoProfile db user pId
|
||||
updatePCCIncognito db user conn Nothing sLnk
|
||||
@@ -2166,11 +2167,14 @@ processChatCommand cxt nm = \case
|
||||
recreateConn user conn@PendingContactConnection {customUserProfileId, connLinkInv} newUser = do
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let short = isJust $ connShortLink' =<< connLinkInv
|
||||
userLinkData_ <-
|
||||
(agConnId, ccLink) <-
|
||||
if short
|
||||
then Just . UserInvLinkData . (`contactShortLinkData` Nothing) <$> presentUserBadge newUser Nothing (userProfileDirect newUser Nothing Nothing True)
|
||||
else pure Nothing
|
||||
(agConnId, ccLink) <- withAgent $ \a -> createConnection a nm (aUserId newUser) True False SCMInvitation userLinkData_ Nothing IKPQOn True subMode
|
||||
then do
|
||||
rootKey <- atomically . C.generateKeyPair =<< asks random
|
||||
(preparedLink, preparedParams@PreparedLinkParams {plpLinkKey = LinkKey linkKey}) <- withAgent $ \a -> prepareConnectionLink a (aUserId newUser) SCMInvitation rootKey Nothing False Nothing IKPQOn False Nothing
|
||||
userLinkData <- UserInvLinkData . (`contactShortLinkData` Nothing) <$> presentUserBadge newUser Nothing (Just $ PHLink linkKey) (userProfileDirect newUser Nothing Nothing True)
|
||||
withAgent $ \a -> createConnectionForLink a nm (aUserId newUser) True preparedLink preparedParams userLinkData subMode
|
||||
else withAgent $ \a -> createConnection a nm (aUserId newUser) True False SCMInvitation Nothing Nothing IKPQOn True subMode
|
||||
ccLink' <- shortenCreatedLink ccLink
|
||||
conn' <- withFastStore' $ \db -> do
|
||||
deleteConnectionRecord db user connId
|
||||
@@ -2205,8 +2209,8 @@ processChatCommand cxt nm = \case
|
||||
Just (AChatItem SCTGroup dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci}
|
||||
_ -> Chat cInfo [] emptyChatStats
|
||||
pure $ CRNewPreparedChat user $ AChat SCTGroup chat
|
||||
ACCL _ (CCLink cReq _) -> do
|
||||
ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink welcomeSharedMsgId (True <$ verifiedDomain)
|
||||
ACCL _ (CCLink cReq sLnk) -> do
|
||||
ct <- withStore $ \db -> createPreparedContact db cxt user (linkPresHeader <$> sLnk) profile accLink welcomeSharedMsgId (True <$ verifiedDomain)
|
||||
void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing Nothing (Just epochStart)
|
||||
let cd = CDDirectRcv ct
|
||||
createItem sharedMsgId content = createChatItem user cd False content sharedMsgId Nothing Nothing
|
||||
@@ -2468,15 +2472,15 @@ processChatCommand cxt nm = \case
|
||||
Just True -> (IKUsePQ, True)
|
||||
Just False -> (IKPQOn, True)
|
||||
Nothing -> (IKPQOn, False)
|
||||
(ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) rootKey entityId True Nothing pqInitKeys useDR server_
|
||||
(ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) SCMContact rootKey (Just entityId) True Nothing pqInitKeys useDR server_
|
||||
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)
|
||||
else (`contactShortLinkData` Nothing) <$> presentUserBadge user Nothing (linkPresHeader <$> connShortLink' ccLink) (userProfileDirect user Nothing Nothing True)
|
||||
let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
|
||||
connId <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData subMode
|
||||
(connId, _) <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData subMode
|
||||
let ccLink'' = if isTrue userChatRelay then setShortLinkType CCTRelay ccLink' else ccLink'
|
||||
withFastStore $ \db -> createUserContactLink db user connId ccLink'' subMode rootPrivKey
|
||||
pure $ CRUserContactLinkCreated user ccLink''
|
||||
@@ -2745,7 +2749,7 @@ processChatCommand cxt nm = \case
|
||||
let entityId = C.sha256Hash $ C.pubKeyBytes rootPubKey
|
||||
crClientData = encodeJSON $ CRDataGroup groupLinkId
|
||||
-- prepare link with entityId as linkEntityId (no server request)
|
||||
(ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) rootKey entityId True (Just crClientData) IKPQOff False Nothing
|
||||
(ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) SCMContact rootKey (Just entityId) True (Just crClientData) IKPQOff False Nothing
|
||||
ccLink' <- setShortLinkType CCTChannel <$> shortenCreatedLink ccLink
|
||||
sLnk <- case connShortLink' ccLink' of
|
||||
Just sl -> pure sl
|
||||
@@ -2758,14 +2762,14 @@ processChatCommand cxt nm = \case
|
||||
userData = encodeShortLinkData $ GroupShortLinkData {groupProfile = groupProfile', publicGroupData = Just (PublicGroupData 1)}
|
||||
userLinkData = UserContactLinkData UserContactData {direct = False, owners = [ownerAuth], relays = [], userData, ratchetKeys = Nothing}
|
||||
-- create connection with prepared link (single network call)
|
||||
connId <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData subMode
|
||||
(connId, _) <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData subMode
|
||||
let groupKeys = GKPublicGroup {groupRootKey = GRKPrivate rootPrivKey, memberPrivKey}
|
||||
setupLink gInfo = do
|
||||
-- TODO [relays] starting role should be communicated in protocol from owner to relays
|
||||
subRole <- asks $ channelSubscriberRole . config
|
||||
gLink <- withFastStore $ \db -> createGroupLink db gVar user gInfo connId ccLink' groupLinkId subRole subMode
|
||||
relays <- withFastStore $ \db -> mapM (getChatRelayById db user) (L.toList relayIds)
|
||||
results <- addRelays user gInfo sLnk relays
|
||||
results <- addRelays user (GIK gInfo groupKeys) sLnk relays
|
||||
pure (gLink, results)
|
||||
pure (groupProfile', memberId, groupKeys, setupLink)
|
||||
NewPublicGroup incognito relayIds gProfile -> withUser $ \User {userId} ->
|
||||
@@ -2777,10 +2781,10 @@ processChatCommand cxt nm = \case
|
||||
pure (gInfo, relays)
|
||||
pure $ CRGroupRelays user gInfo relays
|
||||
APIAddGroupRelays groupId relayIds -> withUser $ \user -> withGroupLock "addGroupRelays" groupId $ do
|
||||
(gInfo, existingRelays) <- withFastStore $ \db -> do
|
||||
gi <- getGroupInfo db cxt user groupId
|
||||
(g@(GIK gInfo _), existingRelays) <- withFastStore $ \db -> do
|
||||
g@(GIK gi _) <- getGroupInfoKeys db cxt user groupId
|
||||
rs <- liftIO $ getGroupRelays db gi
|
||||
pure (gi, rs)
|
||||
pure (g, rs)
|
||||
assertUserGroupRole gInfo GROwner
|
||||
unless (useRelays' gInfo) $ throwCmdError "group does not use relays"
|
||||
let existingRelayIds = map (\GroupRelay {userChatRelay = UserChatRelay {chatRelayId = DBEntityId rId}} -> rId) existingRelays
|
||||
@@ -2790,7 +2794,7 @@ processChatCommand cxt nm = \case
|
||||
Just sl -> pure sl
|
||||
Nothing -> throwChatError $ CEException "group link has no short link"
|
||||
relays <- withFastStore $ \db -> mapM (getChatRelayById db user) (L.toList relayIds)
|
||||
results <- addRelays user gInfo sLnk relays
|
||||
results <- addRelays user g sLnk relays
|
||||
case partitionEithers (map snd results) of
|
||||
([], _) -> do
|
||||
relays' <- withFastStore $ \db -> liftIO $ getGroupRelays db gInfo
|
||||
@@ -2843,12 +2847,11 @@ processChatCommand cxt nm = \case
|
||||
inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db cxt user groupId
|
||||
(inv,) <$> getContactViaMember db cxt user fromMember
|
||||
let ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership, chatSettings}, groupKeys = gks} = invitation
|
||||
GroupMember {memberId = membershipMemId} = membership
|
||||
Contact {activeConn} = ct
|
||||
case activeConn of
|
||||
Just Connection {peerChatVRange} -> do
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
dm <- encodeConnInfo $ XGrpAcpt membershipMemId (Just $ groupMemberKey gks)
|
||||
dm <- encodeXGrpAcpt user (GIK g gks) peerChatVRange
|
||||
agentConnId <- case memberConn fromMember of
|
||||
Nothing -> do
|
||||
(agentConnId, _) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True connRequest PQSupportOff
|
||||
@@ -3401,21 +3404,21 @@ processChatCommand cxt nm = \case
|
||||
-- so incognito profile can be attached to it and be visible in UI before accepting
|
||||
Nothing -> joinNewConn subMode
|
||||
Just conn@Connection {connStatus} -> case connStatus of
|
||||
ConnPrepared -> joinPreparedConn subMode conn
|
||||
ConnPrepared -> joinPreparedConn subMode conn $ connPresHeader conn
|
||||
_ -> throwChatError $ CEException "connection already started (past prepared status)"
|
||||
where
|
||||
joinNewConn subMode = do
|
||||
-- possible improvement: use agent connRequestAgentVersion to determine pqSupport here;
|
||||
-- for joinPreparedConn below - same + encodeConnInfoPQ;
|
||||
-- same for auto-accept on xGrpDirectInv
|
||||
(acId, _) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq PQSupportOff
|
||||
(acId, binding) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq PQSupportOff
|
||||
conn <- withStore $ \db -> do
|
||||
connId <- liftIO $ createMemberContactConn db user acId Nothing gInfo mConn ConnPrepared contactId subMode
|
||||
getConnectionById db cxt user connId
|
||||
joinPreparedConn subMode conn
|
||||
joinPreparedConn subMode conn = do
|
||||
joinPreparedConn subMode conn $ pure $ Just $ directPresHeader binding
|
||||
joinPreparedConn subMode conn getPresHeader = do
|
||||
-- [incognito] send membership incognito profile
|
||||
p <- presentUserBadge user (incognitoMembershipProfile gInfo) $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile gInfo) Nothing True
|
||||
p <- presentUserBadgeWith user (incognitoMembershipProfile gInfo) getPresHeader $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile gInfo) Nothing True
|
||||
dm <- encodeConnInfo $ XInfo p Nothing
|
||||
sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm PQSupportOff subMode
|
||||
let newStatus = if sqSecured then ConnSndReady else ConnJoined
|
||||
@@ -3821,7 +3824,7 @@ processChatCommand cxt nm = \case
|
||||
| connStatus == ConnNew && contactConnInitiated -> joinNewConn chatV -- own connection link
|
||||
| connStatus == ConnPrepared -> do -- retrying join after error
|
||||
localIncognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId
|
||||
joinPreparedConn conn (fromLocalProfile <$> localIncognitoProfile)
|
||||
joinPreparedConn conn (fromLocalProfile <$> localIncognitoProfile) $ connPresHeader conn
|
||||
Just ent -> throwCmdError $ "connection is not RcvDirectMsgConnection: " <> show (connEntityInfo ent)
|
||||
where
|
||||
-- all supported versions support PQ encryption
|
||||
@@ -3829,12 +3832,12 @@ processChatCommand cxt nm = \case
|
||||
joinNewConn chatV = do
|
||||
-- [incognito] generate profile to send
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
(connId, _) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup'
|
||||
(connId, binding) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup'
|
||||
let ccLink = CCLink cReq $ serverShortLink <$> sLnk_
|
||||
conn <- withFastStore' $ \db -> createDirectConnection' db userId connId ccLink contactId_ ConnPrepared incognitoProfile subMode chatV pqSup'
|
||||
joinPreparedConn conn incognitoProfile
|
||||
joinPreparedConn conn incognitoProfile = do
|
||||
profileToSend <- presentUserBadge user incognitoProfile $ userProfileDirect user incognitoProfile Nothing True
|
||||
joinPreparedConn conn incognitoProfile $ pure $ Just $ directPresHeader binding
|
||||
joinPreparedConn conn incognitoProfile getPresHeader = do
|
||||
profileToSend <- presentUserBadgeWith user incognitoProfile getPresHeader $ userProfileDirect user incognitoProfile Nothing True
|
||||
dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend Nothing
|
||||
sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm pqSup' subMode
|
||||
let newStatus = if sqSecured then ConnSndReady else ConnJoined
|
||||
@@ -3888,14 +3891,14 @@ processChatCommand cxt nm = \case
|
||||
when (incognito /= isJust customUserProfileId) $ throwCmdError "incognito mode is different from prepared connection"
|
||||
-- TODO [relays] member: refactor joinContact and up avoiding parallel ifs, xContactId is not used
|
||||
xContactId <- mkXContactId xContactId_
|
||||
(cReq', localIncognitoProfile) <- withFastStore $ \db -> (,) <$> getConnReqContact db connId <*> forM customUserProfileId (getProfileById db userId)
|
||||
((cReq', reqHeader_), localIncognitoProfile) <- withFastStore $ \db -> (,) <$> getConnReqContact db connId <*> forM customUserProfileId (getProfileById db userId)
|
||||
let incognitoProfile = fromLocalProfile <$> localIncognitoProfile
|
||||
conn' <- joinContact user conn cReq' incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ PQSupportOn
|
||||
conn' <- joinContact user conn cReq' incognitoProfile reqHeader_ xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ PQSupportOn
|
||||
pure $ CVRSentInvitation conn' incognitoProfile
|
||||
connect' groupLinkId xContactId_ gInfo_ = do
|
||||
let inGroup = isJust groupLinkId
|
||||
pqSup = if inGroup then PQSupportOff else PQSupportOn
|
||||
(connId, chatV) <- prepareContact user cReq pqSup
|
||||
(connId, chatV, reqHeader) <- prepareContact user cReq pqSup
|
||||
xContactId <- mkXContactId xContactId_
|
||||
-- [incognito] generate profile to send, or use membership profile for relay groups
|
||||
incognitoProfile_ <- case gInfo_ of
|
||||
@@ -3904,8 +3907,8 @@ processChatCommand cxt nm = \case
|
||||
let incognitoProfile = fromIncognitoProfile <$> incognitoProfile_
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let sLnk' = serverShortLink <$> sLnk
|
||||
conn <- withFastStore' $ \db -> createConnReqConnection db userId connId preparedEntity_ cReq cReqHash1 sLnk' xContactId incognitoProfile_ groupLinkId subMode chatV pqSup
|
||||
conn' <- joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ pqSup
|
||||
conn <- withFastStore' $ \db -> createConnReqConnection db userId connId preparedEntity_ cReq reqHeader cReqHash1 sLnk' xContactId incognitoProfile_ groupLinkId subMode chatV pqSup
|
||||
conn' <- joinContact user conn cReq incognitoProfile (Just reqHeader) xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ pqSup
|
||||
pure $ CVRSentInvitation conn' incognitoProfile
|
||||
connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> CreatedLinkContact -> CM ChatResponse
|
||||
connectContactViaAddress user@User {userId} incognito ct@Contact {contactId, activeConn} (CCLink cReq shortLink) =
|
||||
@@ -3913,23 +3916,23 @@ processChatCommand cxt nm = \case
|
||||
case activeConn of
|
||||
Nothing -> do
|
||||
let pqSup = PQSupportOn
|
||||
(connId, chatV) <- prepareContact user cReq pqSup
|
||||
(connId, chatV, reqHeader) <- prepareContact user cReq pqSup
|
||||
newXContactId <- XContactId <$> drgRandomBytes 16
|
||||
-- [incognito] generate profile to send
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let cReqHash = contactCReqHash cReq
|
||||
conn <- withFastStore' $ \db -> createConnReqConnection db userId connId (Just $ PCEContact ct) cReq cReqHash shortLink newXContactId (NewIncognito <$> incognitoProfile) Nothing subMode chatV pqSup
|
||||
void $ joinContact user conn cReq incognitoProfile newXContactId Nothing Nothing Nothing Nothing pqSup
|
||||
conn <- withFastStore' $ \db -> createConnReqConnection db userId connId (Just $ PCEContact ct) cReq reqHeader cReqHash shortLink newXContactId (NewIncognito <$> incognitoProfile) Nothing subMode chatV pqSup
|
||||
void $ joinContact user conn cReq incognitoProfile (Just reqHeader) newXContactId Nothing Nothing Nothing Nothing pqSup
|
||||
ct' <- withStore $ \db -> getContact db cxt user contactId
|
||||
pure $ CRSentInvitationToContact user ct' incognitoProfile
|
||||
Just conn@Connection {connId, connStatus, xContactId = xContactId_, customUserProfileId} -> case connStatus of
|
||||
ConnPrepared -> do
|
||||
when (incognito /= isJust customUserProfileId) $ throwCmdError "incognito mode is different from prepared connection"
|
||||
xContactId <- mkXContactId xContactId_
|
||||
(cReq', localIncognitoProfile) <- withFastStore $ \db -> (,) <$> getConnReqContact db connId <*> forM customUserProfileId (getProfileById db userId)
|
||||
((cReq', reqHeader_), localIncognitoProfile) <- withFastStore $ \db -> (,) <$> getConnReqContact db connId <*> forM customUserProfileId (getProfileById db userId)
|
||||
let incognitoProfile = fromLocalProfile <$> localIncognitoProfile
|
||||
void $ joinContact user conn cReq' incognitoProfile xContactId Nothing Nothing Nothing Nothing PQSupportOn
|
||||
void $ joinContact user conn cReq' incognitoProfile reqHeader_ xContactId Nothing Nothing Nothing Nothing PQSupportOn
|
||||
ct' <- withStore $ \db -> getContact db cxt user contactId
|
||||
pure $ CRSentInvitationToContact user ct' incognitoProfile
|
||||
_ -> throwCmdError "contact already has connection"
|
||||
@@ -3970,21 +3973,21 @@ processChatCommand cxt nm = \case
|
||||
deleteMemberConnection m
|
||||
deleteOrUpdateMemberRecord user gInfo m
|
||||
_ -> pure ()
|
||||
prepareContact :: User -> ConnReqContact -> PQSupport -> CM (ConnId, VersionChat)
|
||||
prepareContact :: User -> ConnReqContact -> PQSupport -> CM (ConnId, VersionChat, ProofPresHeader)
|
||||
prepareContact user cReq pqSup = do
|
||||
lift (withAgent' (`connRequestAgentVersion` cReq)) >>= \case
|
||||
Nothing -> throwChatError CEInvalidConnReq
|
||||
Just _ -> do
|
||||
let chatV = initialChatVersion
|
||||
(connId, _) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup
|
||||
pure (connId, chatV)
|
||||
(connId, binding) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup
|
||||
pure (connId, chatV, directPresHeader binding)
|
||||
mkXContactId :: Maybe XContactId -> CM XContactId
|
||||
mkXContactId = maybe (XContactId <$> drgRandomBytes 16) pure
|
||||
joinContact :: User -> Connection -> ConnReqContact -> Maybe Profile -> XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> Maybe (Maybe GroupInfoKeys) -> Maybe MemberId -> PQSupport -> CM Connection
|
||||
joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ pqSup = do
|
||||
joinContact :: User -> Connection -> ConnReqContact -> Maybe Profile -> Maybe ProofPresHeader -> XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> Maybe (Maybe GroupInfoKeys) -> Maybe MemberId -> PQSupport -> CM Connection
|
||||
joinContact user conn cReq incognitoProfile reqHeader_ xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ pqSup = do
|
||||
-- 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
|
||||
presentUserBadge user incognitoProfile presHeader_ $ case gInfo_ of
|
||||
Just gInfo_' -> userProfileInGroup' user ((\(GIK g _) -> g) <$> gInfo_') incognitoProfile
|
||||
Nothing -> userProfileDirect user incognitoProfile Nothing True
|
||||
dm <- case gInfo_ of
|
||||
@@ -3998,6 +4001,10 @@ processChatCommand cxt nm = \case
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
void $ withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm pqSup subMode
|
||||
withFastStore' $ \db -> updateConnectionStatusFromTo db conn ConnPrepared ConnJoined
|
||||
where
|
||||
presHeader_ = case gInfo_ of
|
||||
Just (Just (GIK g _)) | useRelays' g -> groupPresHeader g
|
||||
_ -> reqHeader_
|
||||
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
|
||||
contactMember Contact {contactId} =
|
||||
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
|
||||
@@ -4052,7 +4059,8 @@ processChatCommand cxt nm = \case
|
||||
case changedCts_ of
|
||||
Nothing -> pure $ UserProfileUpdateSummary 0 0 []
|
||||
Just changedCts -> do
|
||||
idsEvts <- mapM ctSndEvent changedCts
|
||||
presHeaders <- if presentsUserBadge user' then connsPresHeaders $ map (\ChangedProfileContact {conn} -> conn) $ L.toList changedCts else pure M.empty
|
||||
idsEvts <- mapM (ctSndEvent presHeaders) changedCts
|
||||
msgReqs_ <- lift $ L.zipWith ctMsgReq changedCts <$> createSndMessages idsEvts
|
||||
(errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_
|
||||
unless (null errs) $ toView $ CEvtChatErrors errs
|
||||
@@ -4077,18 +4085,19 @@ processChatCommand cxt nm = \case
|
||||
ct' = updateMergedPreferences user' ct
|
||||
mergedProfile' = userProfileDirect user' Nothing (Just ct') False
|
||||
-- non-incognito (filtered above), so the user's badge is presented; a profile update keeps the badge instead of clearing it
|
||||
ctSndEvent :: ChangedProfileContact -> CM (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent 'Json)
|
||||
ctSndEvent ChangedProfileContact {mergedProfile', conn = Connection {connId}} = do
|
||||
p'' <- presentUserBadge user' Nothing mergedProfile'
|
||||
ctSndEvent :: Map ConnId ProofPresHeader -> ChangedProfileContact -> CM (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent 'Json)
|
||||
ctSndEvent presHeaders ChangedProfileContact {mergedProfile', conn = conn@Connection {connId}} = do
|
||||
p'' <- presentUserBadge user' Nothing (M.lookup (aConnId conn) presHeaders) mergedProfile'
|
||||
pure (ConnectionId connId, Nothing, XInfo p'' Nothing)
|
||||
ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq
|
||||
ctMsgReq ChangedProfileContact {conn} =
|
||||
fmap $ \SndMessage {msgId, msgBody} ->
|
||||
(conn, MsgFlags {notification = hasNotification XInfo_}, (vrValue msgBody, [msgId]))
|
||||
setMyAddressData :: Bool -> Maybe InitialKeys -> User -> UserContactLink -> CM UserContactLink
|
||||
setMyAddressData rotateKeys pqInitKeys user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _, addressSettings} = do
|
||||
setMyAddressData rotateKeys pqInitKeys user@User {userChatRelay} 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)
|
||||
let getPresHeader = Just . linkPresHeader <$> maybe (withAgent $ \a -> prepareConnShortLink a (aConnId conn) Nothing) pure sLnk_
|
||||
shortLinkProfile <- presentUserBadgeWith user Nothing getPresHeader (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
|
||||
@@ -4102,7 +4111,7 @@ processChatCommand cxt nm = \case
|
||||
pure ucl'
|
||||
updateContactPrefs :: User -> Contact -> Preferences -> CM ChatResponse
|
||||
updateContactPrefs _ ct@Contact {activeConn = Nothing} _ = throwChatError $ CEContactNotActive ct
|
||||
updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs'
|
||||
updateContactPrefs user@User {userId} ct@Contact {activeConn = Just conn@Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs'
|
||||
| contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated user ct ct
|
||||
| otherwise = do
|
||||
assertDirectAllowed user MDSnd ct XInfo_
|
||||
@@ -4112,7 +4121,7 @@ processChatCommand cxt nm = \case
|
||||
mergedProfile' = userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') False
|
||||
when (mergedProfile' /= mergedProfile) $
|
||||
withContactLock "updateContactPrefs" (contactId' ct) $ do
|
||||
p <- presentUserBadge user incognitoProfile mergedProfile'
|
||||
p <- presentUserBadgeWith user incognitoProfile (connPresHeader conn) mergedProfile'
|
||||
void (sendDirectContactMessage user ct' $ XInfo p Nothing) `catchAllErrors` eToView
|
||||
lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct'
|
||||
pure $ CRContactPrefsUpdated user ct ct'
|
||||
@@ -4311,8 +4320,8 @@ processChatCommand cxt nm = \case
|
||||
toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci]
|
||||
forM_ (timed_ >>= timedDeleteAt') $
|
||||
startProximateTimedItemThread user (ChatRef CTDirect contactId Nothing, chatItemId' ci)
|
||||
addRelays :: User -> GroupInfo -> ShortLinkContact -> [UserChatRelay] -> CM [(UserChatRelay, Either ChatError GroupRelay)]
|
||||
addRelays user gInfo@GroupInfo {membership} groupSLink relays =
|
||||
addRelays :: User -> GroupInfoKeys -> ShortLinkContact -> [UserChatRelay] -> CM [(UserChatRelay, Either ChatError GroupRelay)]
|
||||
addRelays user g@(GIK gInfo@GroupInfo {membership} gks) groupSLink relays =
|
||||
mapConcurrently addRelay relays
|
||||
where
|
||||
addRelay :: UserChatRelay -> CM (UserChatRelay, Either ChatError GroupRelay)
|
||||
@@ -4332,14 +4341,17 @@ processChatCommand cxt nm = \case
|
||||
pure (relayMember, conn, groupRelay)
|
||||
let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
||||
GroupMember {memberId = relayMemberId} = relayMember
|
||||
membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
|
||||
membershipProfile <- membershipHandshakeProfile user gInfo
|
||||
let relayInv = GroupRelayInvitation {
|
||||
fromMember = MemberIdRole userMemberId userRole,
|
||||
fromMemberProfile = membershipProfile,
|
||||
relayMemberId,
|
||||
groupLink = groupSLink
|
||||
groupLink = groupSLink,
|
||||
publicGroupId = (\PublicGroupProfile {publicGroupId = gId} -> gId) <$> publicGroup' gInfo,
|
||||
fromMemberKey = Just $ groupMemberKey gks
|
||||
}
|
||||
dm <- encodeConnInfo $ XGrpRelayInv relayInv
|
||||
msg = XGrpRelayInv relayInv
|
||||
dm <- encodeConnInfoSigning PQSupportOff (groupMsgSigning False g msg) msg
|
||||
sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm PQSupportOff subMode
|
||||
let newConnStatus = if sqSecured then ConnSndReady else ConnJoined
|
||||
withFastStore' $ \db -> do
|
||||
@@ -4417,7 +4429,7 @@ processChatCommand cxt nm = \case
|
||||
Just (createdLink, p) -> pure (createdLink, Nothing, Nothing, p)
|
||||
Nothing -> do
|
||||
(FixedLinkData {rootKey}, cData, cReq) <- getShortLinkConnReq nm user l'
|
||||
contactSLinkData_ <- mapM linkDataBadge =<< liftIO (decodeLinkUserData cData)
|
||||
contactSLinkData_ <- mapM (linkDataBadge $ linkPresHeader l') =<< liftIO (decodeLinkUserData cData)
|
||||
let ov = verifyLinkOwner rootKey [] l sig_
|
||||
invitationReqAndPlan cReq (Just l') contactSLinkData_ ov
|
||||
where
|
||||
@@ -4471,12 +4483,13 @@ processChatCommand cxt nm = \case
|
||||
when (resolveMode == PRMNever) $ throwChatError CENotResolvedLocally
|
||||
l' <- resolveSLink
|
||||
(FixedLinkData {rootKey}, cData, cReq) <- getShortLinkConnReq nm user l'
|
||||
contactSLinkData_ <- mapM linkDataBadge =<< liftIO (decodeLinkUserData cData)
|
||||
let presHeader = linkPresHeader l'
|
||||
contactSLinkData_ <- mapM (linkDataBadge presHeader) =<< liftIO (decodeLinkUserData cData)
|
||||
let linkProfile_ = (\ContactShortLinkData {profile} -> profile) <$> contactSLinkData_
|
||||
linkDomain_ = linkProfile_ >>= \Profile {contactDomain} -> claimDomain <$> contactDomain
|
||||
planDomain = case nl of CTName ni -> Just (nameDomain ni); _ -> Nothing
|
||||
refreshContact ct' = case (planDomain, linkProfile_) of
|
||||
(Just _, Just p) -> updateContactFromLinkData user ct' p
|
||||
(Just _, Just p) -> updateContactFromLinkData user ct' presHeader p
|
||||
_ -> pure ct'
|
||||
forM_ planDomain $ \nameDomain ->
|
||||
unless (linkDomain_ == Just nameDomain) $ throwChatError $ CESimplexDomainNotReady nameDomain SDEUnknownDomain
|
||||
@@ -5223,14 +5236,12 @@ presentUserBadgeToContacts user'@User {userId, profile = LocalProfile {localBadg
|
||||
lift $ withAgent' $ \a -> setUserEntitlement a (aUserId user') (badgeServerCredential localBadge)
|
||||
cxt <- chatStoreCxt
|
||||
contacts <- withFastStore' $ \db -> getUserContacts db cxt user'
|
||||
withChatLock "presentUserBadge" $ forM_ contacts $ \ct ->
|
||||
case contactSendConn_ ct of
|
||||
Right conn
|
||||
| not (connIncognito conn) -> do
|
||||
let ct' = updateMergedPreferences user' ct
|
||||
p <- presentUserBadge user' Nothing $ userProfileDirect user' Nothing (Just ct') False
|
||||
void (sendDirectContactMessage user' ct' (XInfo p Nothing)) `catchAllErrors` eToView
|
||||
_ -> pure ()
|
||||
let sendConns = [(ct, conn) | ct <- contacts, Right conn <- [contactSendConn_ ct], not (connIncognito conn)]
|
||||
presHeaders <- if presentsUserBadge user' then connsPresHeaders $ map snd sendConns else pure M.empty
|
||||
withChatLock "presentUserBadge" $ forM_ sendConns $ \(ct, conn) -> do
|
||||
let ct' = updateMergedPreferences user' ct
|
||||
p <- presentUserBadge user' Nothing (M.lookup (aConnId conn) presHeaders) $ userProfileDirect user' Nothing (Just ct') False
|
||||
void (sendDirectContactMessage user' ct' (XInfo p Nothing)) `catchAllErrors` eToView
|
||||
|
||||
-- | The check character is verified before anything leaves the device, and the signing keys are
|
||||
-- stashed before the request is sent, so a retry reaches the service as the same signer.
|
||||
|
||||
@@ -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 (..), BadgeInfo (..), ProofPresHeader (..), BadgeProof (..), BadgeProofKind (..), BadgeStatus (..), FileSizeLimits (..), LocalBadge (..), badgeProof, badgeSndGraceInterval, generateBadgeProof, localBadgeStatus, maxXFTPFileSize, mkBadgeStatus, verifyBadge)
|
||||
import Simplex.Chat.Badges (BadgeCredential (..), BadgeInfo (..), ProofPresHeader (..), BadgeProof (..), BadgeProofKind (..), BadgeStatus (..), FileSizeLimits (..), LocalBadge (..), acceptedProof, badgeSndGraceInterval, generateBadgeProof, localBadgeStatus, maxXFTPFileSize, mkBadgeStatus, verifyBadge)
|
||||
import Simplex.Chat.Names (SimplexDomainClaim (..), claimDomain)
|
||||
import Simplex.Chat.Call
|
||||
import Simplex.Chat.Controller
|
||||
@@ -992,28 +992,28 @@ acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId
|
||||
pqSup' = pqSup `CR.pqSupportAnd` pqSupport
|
||||
cxt <- chatStoreCxt
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
(ct, conn, incognitoProfile) <- case contactId_ of
|
||||
(ct, conn, incognitoProfile, getPresHeader) <- case contactId_ of
|
||||
Nothing -> do
|
||||
incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
|
||||
(connId, _) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) True invId pqSup'
|
||||
(connId, binding) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) True invId pqSup'
|
||||
(ct, conn) <- withStore' $ \db ->
|
||||
createContactFromRequest db user userContactLinkId_ connId chatV cReqChatVRange cName profileId cp xContactId incognitoProfile subMode pqSup' False
|
||||
pure (ct, conn, incognitoProfile)
|
||||
pure (ct, conn, incognitoProfile, pure $ Just $ directPresHeader binding)
|
||||
Just contactId -> do
|
||||
ct <- withFastStore $ \db -> getContact db cxt user contactId
|
||||
case contactConn ct of
|
||||
Nothing -> do
|
||||
incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
|
||||
(connId, _) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) True invId pqSup'
|
||||
(connId, binding) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) True invId pqSup'
|
||||
currentTs <- liftIO getCurrentTime
|
||||
conn <- withStore' $ \db -> do
|
||||
forM_ xContactId $ \xcId -> setContactAcceptedXContactId db ct xcId
|
||||
createAcceptedContactConn db user userContactLinkId_ contactId connId chatV cReqChatVRange pqSup' incognitoProfile subMode currentTs
|
||||
pure (ct {activeConn = Just conn} :: Contact, conn, incognitoProfile)
|
||||
pure (ct {activeConn = Just conn} :: Contact, conn, incognitoProfile, pure $ Just $ directPresHeader binding)
|
||||
Just conn@Connection {customUserProfileId} -> do
|
||||
incognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId
|
||||
pure (ct, conn, ExistingIncognito <$> incognitoProfile)
|
||||
profileToSend <- presentUserBadge user incognitoProfile $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
|
||||
pure (ct, conn, ExistingIncognito <$> incognitoProfile, connPresHeader conn)
|
||||
profileToSend <- presentUserBadgeWith user incognitoProfile getPresHeader $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
|
||||
dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend Nothing
|
||||
(ct,conn,) <$> withAgent (\a -> acceptContact a nm (aUserId user) (aConnId conn) True invId dm pqSup' subMode)
|
||||
|
||||
@@ -1025,10 +1025,10 @@ acceptContactRequestAsync
|
||||
UserContactRequest {agentInvitationId = AgentInvId cReqInvId, cReqChatVRange, xContactId, pqSupport = cReqPQSup}
|
||||
incognitoProfile = do
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
profileToSend <- presentUserBadge user incognitoProfile $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
|
||||
cxt <- chatStoreCxt
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
(cmdId, acId) <- prepareAgentAccept user True cReqInvId cReqPQSup
|
||||
((cmdId, acId), presHeader) <- prepareAgentAccept user True cReqInvId cReqPQSup
|
||||
profileToSend <- presentUserBadge user incognitoProfile (Just presHeader) $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
|
||||
currentTs <- liftIO getCurrentTime
|
||||
ct' <- withStore $ \db -> do
|
||||
forM_ xContactId $ \xcId -> liftIO $ setContactAcceptedXContactId db ct xcId
|
||||
@@ -1038,7 +1038,7 @@ acceptContactRequestAsync
|
||||
agentAcceptContactAsync cmdId acId True cReqInvId (XInfo profileToSend Nothing) cReqPQSup subMode
|
||||
pure ct'
|
||||
|
||||
acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfoKeys -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> Maybe GroupMember -> CM GroupMember
|
||||
acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfoKeys -> InvitationId -> VersionRangeChat -> Profile -> Maybe ProofPresHeader -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> Maybe GroupMember -> CM GroupMember
|
||||
acceptGroupJoinRequestAsync
|
||||
user@User {userId}
|
||||
uclId
|
||||
@@ -1046,6 +1046,7 @@ acceptGroupJoinRequestAsync
|
||||
cReqInvId
|
||||
cReqChatVRange
|
||||
cReqProfile
|
||||
presHeader_
|
||||
cReqXContactId_
|
||||
cReqMemberId_
|
||||
welcomeMsgId_
|
||||
@@ -1064,10 +1065,10 @@ acceptGroupJoinRequestAsync
|
||||
-- refresh the hash placeholder name from the authenticated join profile; role + key stay roster-authoritative
|
||||
withStore $ \db -> do
|
||||
liftIO $ updateGroupMemberStatus db userId m initialStatus
|
||||
void $ updateMemberProfile db cxt user m cReqProfile
|
||||
void $ updateMemberProfile db cxt user m presHeader_ cReqProfile
|
||||
pure (groupMemberId' m, memberId' m)
|
||||
Nothing -> withStore $ \db ->
|
||||
createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus memberKey_
|
||||
createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile presHeader_ cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus memberKey_
|
||||
let currentMemCount = fromIntegral $ currentMembers $ groupSummary gInfo
|
||||
let Profile {displayName} = userProfileInGroup user gInfo (fromIncognitoProfile <$> incognitoProfile)
|
||||
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
||||
@@ -1085,7 +1086,7 @@ acceptGroupJoinRequestAsync
|
||||
}
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
(cmdId, acId) <- prepareAgentAccept user True cReqInvId PQSupportOff
|
||||
((cmdId, acId), _) <- prepareAgentAccept user True cReqInvId PQSupportOff
|
||||
m <- withStore $ \db -> do
|
||||
liftIO $ createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode
|
||||
getGroupMemberById db cxt user groupMemberId
|
||||
@@ -1105,7 +1106,7 @@ acceptGroupJoinSendRejectAsync
|
||||
gVar <- asks random
|
||||
cxt <- chatStoreCxt
|
||||
(groupMemberId, memberId) <- withStore $ \db ->
|
||||
createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ Nothing Nothing GRObserver GSMemRejected Nothing
|
||||
createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile Nothing cReqXContactId_ Nothing Nothing GRObserver GSMemRejected Nothing
|
||||
let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
||||
msg =
|
||||
XGrpLinkReject $
|
||||
@@ -1117,7 +1118,7 @@ acceptGroupJoinSendRejectAsync
|
||||
}
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
(cmdId, acId) <- prepareAgentAccept user False cReqInvId PQSupportOff
|
||||
((cmdId, acId), _) <- prepareAgentAccept user False cReqInvId PQSupportOff
|
||||
m <- withStore $ \db -> do
|
||||
liftIO $ createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode
|
||||
getGroupMemberById db cxt user groupMemberId
|
||||
@@ -1152,7 +1153,7 @@ acceptBusinessJoinRequestAsync
|
||||
}
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
(cmdId, acId) <- prepareAgentAccept user True cReqInvId PQSupportOff
|
||||
((cmdId, acId), _) <- prepareAgentAccept user True cReqInvId PQSupportOff
|
||||
withStore' $ \db -> do
|
||||
forM_ xContactId $ \xcId -> setBusinessChatAcceptedXContactId db gInfo xcId
|
||||
createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode
|
||||
@@ -1179,7 +1180,7 @@ acceptRelayJoinRequestAsync
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
cxt <- chatStoreCxt
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
(cmdId, acId) <- prepareAgentAccept user True cReqInvId PQSupportOff
|
||||
((cmdId, acId), _) <- prepareAgentAccept user True cReqInvId PQSupportOff
|
||||
r <- withStore $ \db -> do
|
||||
liftIO $ createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode
|
||||
gInfo' <- liftIO $ updateRelayOwnStatusFromTo db gInfo RSInvited RSAccepted
|
||||
@@ -1193,20 +1194,21 @@ rejectRelayInvitationAsync
|
||||
-> Int64
|
||||
-> StoreCxt
|
||||
-> GroupRelayInvitation
|
||||
-> Maybe ProofPresHeader
|
||||
-> InvitationId
|
||||
-> VersionRangeChat
|
||||
-> Int64
|
||||
-> RelayRejectionReason
|
||||
-> CM ()
|
||||
rejectRelayInvitationAsync user uclId cxt groupRelayInv invId reqChatVRange initialDelay reason = do
|
||||
rejectRelayInvitationAsync user uclId cxt groupRelayInv presHeader_ invId reqChatVRange initialDelay reason = do
|
||||
(_gInfo, ownerMember) <- withStore $ \db ->
|
||||
createRelayRequestGroup db cxt user groupRelayInv invId reqChatVRange initialDelay GSMemInvited RSRejected
|
||||
createRelayRequestGroup db cxt user groupRelayInv presHeader_ invId reqChatVRange initialDelay GSMemInvited RSRejected
|
||||
let GroupMember {groupMemberId} = ownerMember
|
||||
msg = XGrpRelayReject reason
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
chatVR <- chatVersionRange
|
||||
let chatV = chatVR `peerConnChatVersion` reqChatVRange
|
||||
(cmdId, acId) <- prepareAgentAccept user False invId PQSupportOff
|
||||
((cmdId, acId), _) <- prepareAgentAccept user False invId PQSupportOff
|
||||
withStore' $ \db ->
|
||||
createJoiningMemberConnection db user uclId (cmdId, acId) chatV reqChatVRange groupMemberId subMode
|
||||
agentAcceptContactAsync cmdId acId False invId msg PQSupportOff subMode
|
||||
@@ -1345,14 +1347,16 @@ userProfileInGroup' User {profile = p} mg incognitoProfile =
|
||||
in maybe p' (\g -> redactedMemberProfile g (membership g) p') mg
|
||||
|
||||
memberInfo :: GroupInfo -> GroupMember -> MemberInfo
|
||||
memberInfo g m@GroupMember {memberId, memberRole, memberProfile, memberPubKey, activeConn} =
|
||||
memberInfo g m@GroupMember {memberId, memberRole, memberProfile, memberPubKey, activeConn, memberBadgeProof} =
|
||||
MemberInfo
|
||||
{ memberId,
|
||||
memberRole,
|
||||
v = ChatVersionRange . peerChatVRange <$> activeConn,
|
||||
profile = redactedMemberProfile g m $ fromLocalProfile memberProfile,
|
||||
profile = (p :: Profile) {badge = mfilter (acceptedProof $ memberPresHeader g memberId memberPubKey) (unNoJSON memberBadgeProof <|> badge)},
|
||||
memberKey = MemberKey <$> memberPubKey
|
||||
}
|
||||
where
|
||||
p@Profile {badge} = redactedMemberProfile g m $ fromLocalProfile memberProfile
|
||||
|
||||
redactedMemberProfile :: GroupInfo -> GroupMember -> Profile -> Profile
|
||||
redactedMemberProfile g m Profile {displayName, fullName, shortDescr, description, image, contactLink = lnk, peerType, badge, contactDomain} =
|
||||
@@ -1649,12 +1653,12 @@ updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupSummary = G
|
||||
newClaim = groupClaim groupProfile
|
||||
verifyResolved = isJust resolvedDomain_ && resolvedDomain_ == newClaim
|
||||
|
||||
updateContactFromLinkData :: User -> Contact -> Profile -> CM Contact
|
||||
updateContactFromLinkData user ct@Contact {profile = profile@LocalProfile {contactDomain = prevClaim, contactDomainVerified}} linkProfile@Profile {contactDomain = newClaim}
|
||||
updateContactFromLinkData :: User -> Contact -> ProofPresHeader -> Profile -> CM Contact
|
||||
updateContactFromLinkData user ct@Contact {profile = profile@LocalProfile {contactDomain = prevClaim, contactDomainVerified}} presHeader linkProfile@Profile {contactDomain = newClaim}
|
||||
| profileChanged || verifyChanged = do
|
||||
cxt <- chatStoreCxt
|
||||
withFastStore $ \db -> do
|
||||
ct' <- updateContactProfile db cxt user ct linkProfile
|
||||
ct' <- updateContactProfile db cxt user ct (Just presHeader) linkProfile
|
||||
if verifyChanged then liftIO $ setContactDomainVerified db user ct' True else pure ct'
|
||||
| otherwise = pure ct
|
||||
where
|
||||
@@ -2250,25 +2254,49 @@ sendDirectContactMessages user ct events = do
|
||||
-- present the user's own badge on an outgoing profile: a fresh, single-use proof from the stored credential.
|
||||
-- the send's incognito profile (when set) suppresses it - an incognito identity must never carry the badge.
|
||||
-- a long-expired badge is not presented at all (receivers would hide it anyway).
|
||||
presentUserBadge :: User -> Maybe i -> Profile -> CM Profile
|
||||
presentUserBadge User {profile = LocalProfile {localBadge}} incognitoProfile p = case (incognitoProfile, localBadge) of
|
||||
(Nothing, Just (OwnBadge cred@(BadgeCredential keyIdx _ _ _) st)) | st == BSActive || st == BSExpired -> do
|
||||
keys <- asks $ badgePublicKeys . config
|
||||
case M.lookup keyIdx keys of
|
||||
Nothing -> p <$ logError "presentUserBadge: badge key index not in config"
|
||||
Just key -> do
|
||||
nonce <- drgRandomBytes 16
|
||||
liftIO (badgeProof key cred (PHTest nonce)) >>= \case
|
||||
Right proof -> pure p {badge = Just proof}
|
||||
Left e -> p <$ logError ("presentUserBadge: proof generation failed: " <> T.pack e)
|
||||
_ -> pure p
|
||||
presentUserBadge :: User -> Maybe i -> Maybe ProofPresHeader -> Profile -> CM Profile
|
||||
presentUserBadge user incognitoProfile = presentUserBadgeWith user incognitoProfile . pure
|
||||
|
||||
presentUserBadgeWith :: User -> Maybe i -> CM (Maybe ProofPresHeader) -> Profile -> CM Profile
|
||||
presentUserBadgeWith user incognitoProfile getPresHeader p
|
||||
| isNothing incognitoProfile && presentsUserBadge user = do
|
||||
badge <- getPresHeader $>>= sndBadgeProof user
|
||||
pure p {badge}
|
||||
| otherwise = pure p
|
||||
|
||||
presentsUserBadge :: User -> Bool
|
||||
presentsUserBadge User {profile = LocalProfile {localBadge}} = case localBadge of
|
||||
Just (OwnBadge _ st) -> st == BSActive || st == BSExpired
|
||||
_ -> False
|
||||
|
||||
groupPresHeader :: GroupInfo -> Maybe ProofPresHeader
|
||||
groupPresHeader gInfo@GroupInfo {membership = GroupMember {memberId, memberPubKey}} = memberPresHeader gInfo memberId memberPubKey
|
||||
|
||||
membershipHandshakeProfile :: User -> GroupInfo -> CM Profile
|
||||
membershipHandshakeProfile user gInfo@GroupInfo {membership} =
|
||||
presentUserBadge user (incognitoMembershipProfile gInfo) (groupPresHeader gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
|
||||
|
||||
directPresHeader :: ContactRequestBinding -> ProofPresHeader
|
||||
directPresHeader = \case
|
||||
CRBRatchet ConnVerifyCodes {codeAD} -> PHChat $ encodeChatBinding CBDirect $ C.sha256Hash $ "SimpleX badge" <> codeAD
|
||||
CRBRequest code -> PHRequest code
|
||||
|
||||
linkPresHeader :: ConnShortLink c -> ProofPresHeader
|
||||
linkPresHeader = \case
|
||||
CSLInvitation _ _ _ (LinkKey key) -> PHLink key
|
||||
CSLContact _ _ _ (LinkKey key) -> PHLink key
|
||||
|
||||
connPresHeader :: Connection -> CM (Maybe ProofPresHeader)
|
||||
connPresHeader conn = M.lookup (aConnId conn) <$> connsPresHeaders [conn]
|
||||
|
||||
connsPresHeaders :: [Connection] -> CM (Map ConnId ProofPresHeader)
|
||||
connsPresHeaders conns = M.map (directPresHeader . CRBRatchet) <$> withAgent (`getConnectionsVerifyCodes` map aConnId conns)
|
||||
|
||||
-- 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
|
||||
linkDataBadge cld@ContactShortLinkData {profile = Profile {badge}} = case badge of
|
||||
Nothing -> pure cld
|
||||
linkDataBadge :: ProofPresHeader -> ContactShortLinkData -> CM ContactShortLinkData
|
||||
linkDataBadge presHeader cld@ContactShortLinkData {profile = Profile {badge}} = case mfilter (acceptedProof (Just presHeader)) badge of
|
||||
Nothing -> pure (cld :: ContactShortLinkData) {localBadge = Nothing}
|
||||
Just b@(BadgeProof _ _ _ info) -> do
|
||||
keys <- asks $ badgePublicKeys . config
|
||||
verified <- liftIO $ verifyBadge keys b
|
||||
@@ -2331,7 +2359,11 @@ groupMsgSigning sign (GIK gInfo@GroupInfo {membership = GroupMember {memberId}}
|
||||
where
|
||||
memberPrivKey' = memberPrivKey gks
|
||||
tag = toCMEventTag evt
|
||||
shouldSign = requiresSignature tag || (sign && signableContent tag)
|
||||
shouldSign = requiresSignature tag || (sign && signableContent tag) || badgePresented
|
||||
badgePresented = case evt of
|
||||
XGrpMemInfo _ Profile {badge} -> isJust badge
|
||||
XGrpAcpt _ _ (Just Profile {badge}) -> isJust badge
|
||||
_ -> False
|
||||
bindingData = groupBindingData gInfo memberId (C.publicKey memberPrivKey')
|
||||
|
||||
groupBindingData :: GroupInfo -> MemberId -> C.PublicKeyEd25519 -> ByteString
|
||||
@@ -2357,6 +2389,16 @@ rcvGroupChatBinding gInfo m_ asGroup badge_ =
|
||||
(\k -> encodeChatBinding CBGroup $ smpEncode (memberId, k)) <$> (memberPubKey <|> proofMemberKey memberId badge_)
|
||||
_ -> Nothing
|
||||
|
||||
memberPresHeader :: GroupInfo -> MemberId -> Maybe C.PublicKeyEd25519 -> Maybe ProofPresHeader
|
||||
memberPresHeader gInfo memberId = fmap $ memberKeyPresHeader ((\PublicGroupProfile {publicGroupId} -> publicGroupId) <$> publicGroup' gInfo) memberId
|
||||
|
||||
memberKeyPresHeader :: Maybe B64UrlByteString -> MemberId -> C.PublicKeyEd25519 -> ProofPresHeader
|
||||
memberKeyPresHeader publicGroupId_ memberId k =
|
||||
PHChat $ encodeChatBinding CBGroup $ maybe (smpEncode (memberId, k)) (\publicGroupId -> smpEncode (publicGroupId, memberId, k)) publicGroupId_
|
||||
|
||||
memberInfoPresHeader :: GroupInfo -> MemberInfo -> Maybe ProofPresHeader
|
||||
memberInfoPresHeader gInfo MemberInfo {memberId, memberKey} = memberPresHeader gInfo memberId ((\(MemberKey k) -> k) <$> memberKey)
|
||||
|
||||
proofMemberKey :: MemberId -> Maybe BadgeProof -> Maybe C.PublicKeyEd25519
|
||||
proofMemberKey memberId badge_ = do
|
||||
BadgeProof _ (BBSPresHeader phBytes) _ _ <- badge_
|
||||
@@ -2484,6 +2526,9 @@ encodeSignedConnInfo pqSup signing chatMsgEvent = do
|
||||
ECMEncoded body -> compressConnInfo pqSup $ encodeBatchElement (Just $ signChatMsgBody signing body) body
|
||||
ECMLarge -> throwChatError $ CEException "large signed info"
|
||||
|
||||
encodeConnInfoSigning :: MsgEncodingI e => PQSupport -> Maybe MsgSigning -> ChatMsgEvent e -> CM ByteString
|
||||
encodeConnInfoSigning pqSup = maybe (encodeConnInfoPQ pqSup) (encodeSignedConnInfo pqSup)
|
||||
|
||||
-- signed XMember for a relay-group join: proves the joiner holds the member key it asserts, and carries
|
||||
-- viaRelay = the target relay's memberId inside the signed body so a sibling relay can't accept a replay
|
||||
encodeXMemberConnInfo :: PQSupport -> GroupInfoKeys -> MemberId -> Profile -> CM ByteString
|
||||
@@ -2494,6 +2539,14 @@ encodeXMemberConnInfo pqSup (GIK gInfo@GroupInfo {membership = GroupMember {memb
|
||||
signing = MsgSigning CBGroup bindingData KRMember memberPrivKey'
|
||||
in encodeSignedConnInfo pqSup signing xMemberEvt
|
||||
|
||||
encodeXGrpAcpt :: User -> GroupInfoKeys -> VersionRangeChat -> CM ByteString
|
||||
encodeXGrpAcpt user g@(GIK gInfo@GroupInfo {membership = GroupMember {memberId}} gks) peerVRange = do
|
||||
let incognitoProfile = incognitoMembershipProfile gInfo
|
||||
profile <- presentUserBadge user incognitoProfile (groupPresHeader gInfo) (userProfileInGroup user gInfo $ fromLocalProfile <$> incognitoProfile)
|
||||
let msg = XGrpAcpt memberId (Just $ groupMemberKey gks) (Just profile)
|
||||
signing_ = if maxVersion peerVRange >= relayWebCapVersion then groupMsgSigning False g msg else Nothing
|
||||
encodeConnInfoSigning PQSupportOff signing_ msg
|
||||
|
||||
deliverMessage :: Connection -> CMEventTag e -> MsgBody -> MessageId -> CM (Int64, PQEncryption)
|
||||
deliverMessage conn cmEventTag msgBody msgId = do
|
||||
let msgFlags = MsgFlags {notification = hasNotification cmEventTag}
|
||||
@@ -2673,7 +2726,7 @@ sendGroupProfileUpdate user g@(GIK gInfo gks) scope asGroup members =
|
||||
_ -> False
|
||||
sendProfileUpdate = do
|
||||
-- shouldSendProfileUpdate excludes incognito membership, so the badge is presented
|
||||
profileUpdate <- presentUserBadge user Nothing $ redactedMemberProfile gInfo (membership gInfo) $ fromLocalProfile p
|
||||
profileUpdate <- presentUserBadge user Nothing (groupPresHeader gInfo) $ redactedMemberProfile gInfo (membership gInfo) $ fromLocalProfile p
|
||||
void $ sendGroupMessage' user g members $ XInfo profileUpdate (Just $ groupMemberKey gks)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
withStore' $ \db -> updateUserMemberProfileSentAt db user gInfo currentTs
|
||||
@@ -3047,13 +3100,11 @@ prepareAgentCreation user cmdFunction enableNtfs cMode = do
|
||||
connId <- withAgent $ \a -> prepareConnectionToCreate a (aUserId user) enableNtfs cMode PQSupportOff
|
||||
pure (cmdId, connId)
|
||||
|
||||
prepareAgentJoin :: User -> Maybe Connection -> Bool -> ConnectionRequestUri c -> CM (CommandId, ConnId)
|
||||
prepareAgentJoin user conn_ enableNtfs cReqUri = do
|
||||
cmdId <- withStore' $ \db -> createCommand db user (dbConnId <$> conn_) CFJoinConn
|
||||
connId <- case conn_ of
|
||||
Just conn -> pure $ aConnId conn
|
||||
Nothing -> fst <$> withAgent (\a -> prepareConnectionToJoin a (aUserId user) enableNtfs cReqUri PQSupportOff)
|
||||
pure (cmdId, connId)
|
||||
prepareAgentJoin :: User -> Bool -> ConnectionRequestUri c -> CM ((CommandId, ConnId), ProofPresHeader)
|
||||
prepareAgentJoin user enableNtfs cReqUri = do
|
||||
cmdId <- withStore' $ \db -> createCommand db user Nothing CFJoinConn
|
||||
(connId, binding) <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) enableNtfs cReqUri PQSupportOff
|
||||
pure ((cmdId, connId), directPresHeader binding)
|
||||
|
||||
joinAgentConnectionAsync :: CommandId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM ()
|
||||
joinAgentConnectionAsync cmdId updateConn connId enableNtfs cReqUri cInfo subMode =
|
||||
@@ -3064,9 +3115,7 @@ allowAgentConnectionAsync user conn@Connection {pqSupport} confId gInfo_ msg = d
|
||||
let signing_ = case gInfo_ of
|
||||
Just gInfo@(GIK g _) | useRelays' g || maxVersion (peerChatVRange conn) >= relayWebCapVersion -> groupMsgSigning False gInfo msg
|
||||
_ -> Nothing
|
||||
dm <- case signing_ of
|
||||
Just signing -> encodeSignedConnInfo pqSupport signing msg
|
||||
Nothing -> encodeConnInfoPQ pqSupport msg
|
||||
dm <- encodeConnInfoSigning pqSupport signing_ msg
|
||||
allowAgentConnectionInfo user conn confId dm
|
||||
|
||||
allowAgentConnectionInfo :: User -> Connection -> ConfirmationId -> ByteString -> CM ()
|
||||
@@ -3075,11 +3124,11 @@ allowAgentConnectionInfo user conn@Connection {connId} confId dm = do
|
||||
withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm
|
||||
withStore' $ \db -> updateConnectionStatus db conn ConnAccepted
|
||||
|
||||
prepareAgentAccept :: User -> Bool -> InvitationId -> PQSupport -> CM (CommandId, ConnId)
|
||||
prepareAgentAccept :: User -> Bool -> InvitationId -> PQSupport -> CM ((CommandId, ConnId), ProofPresHeader)
|
||||
prepareAgentAccept user enableNtfs invId pqSup = do
|
||||
cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact
|
||||
(connId, _) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) enableNtfs invId pqSup
|
||||
pure (cmdId, connId)
|
||||
(connId, binding) <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) enableNtfs invId pqSup
|
||||
pure ((cmdId, connId), directPresHeader binding)
|
||||
|
||||
agentAcceptContactAsync :: MsgEncodingI e => CommandId -> ConnId -> Bool -> InvitationId -> ChatMsgEvent e -> PQSupport -> SubscriptionMode -> CM ()
|
||||
agentAcceptContactAsync cmdId connId enableNtfs invId msg pqSup subMode = do
|
||||
|
||||
@@ -46,7 +46,7 @@ import Data.Time.Format (defaultTimeLocale, formatTime)
|
||||
import qualified Data.UUID as UUID
|
||||
import qualified Data.UUID.V4 as V4
|
||||
import Data.Word (Word32)
|
||||
import Simplex.Chat.Badges (BadgeProof, BadgeProofKind (..), BadgeStatus (..), FileSizeLimits (..), ProofPresHeader (..))
|
||||
import Simplex.Chat.Badges (BadgeProof (..), BadgeProofKind (..), BadgeStatus (..), FileSizeLimits (..), ProofPresHeader (..), acceptedBadge, localBadgeStatus, sameBadgeProof, unboundProof)
|
||||
import Simplex.Chat.Call
|
||||
import Simplex.Chat.Controller
|
||||
import Simplex.Chat.Delivery
|
||||
@@ -116,10 +116,21 @@ smallGroupsRcptsMemLimit = 20
|
||||
-- Verifies member signatures over CBGroup <> (publicGroupId, memberId) or (memberId, pubKey) <> signedBody under the given key.
|
||||
-- signatures is NonEmpty so the verification can't be vacuously true.
|
||||
verifyGroupSig :: C.PublicKeyEd25519 -> GroupInfo -> MemberId -> NonEmpty MsgSignature -> ByteString -> Bool
|
||||
verifyGroupSig key gInfo memberId signatures signedBody =
|
||||
let prefix = encodeChatBinding CBGroup $ groupBindingData gInfo memberId key
|
||||
verifyGroupSig key gInfo memberId = verifyMemberSig key (groupBindingData gInfo memberId key)
|
||||
|
||||
verifyMemberSig :: C.PublicKeyEd25519 -> ByteString -> NonEmpty MsgSignature -> ByteString -> Bool
|
||||
verifyMemberSig key bindingData signatures signedBody =
|
||||
let prefix = encodeChatBinding CBGroup bindingData
|
||||
in all (\case (MsgSignature KRMember sig) -> C.verify (C.APublicVerifyKey C.SEd25519 key) sig (prefix <> signedBody)) signatures
|
||||
|
||||
relayInvPresHeader :: Maybe SignedMsg -> GroupRelayInvitation -> Maybe ProofPresHeader
|
||||
relayInvPresHeader signedMsg_ GroupRelayInvitation {fromMember = MemberIdRole {memberId}, publicGroupId, fromMemberKey} = do
|
||||
gId <- publicGroupId
|
||||
MemberKey k <- fromMemberKey
|
||||
SignedMsg {chatBinding = CBGroup, signatures, signedBody} <- signedMsg_
|
||||
guard $ verifyMemberSig k (smpEncode (gId, memberId)) signatures signedBody
|
||||
pure $ memberKeyPresHeader (Just gId) memberId k
|
||||
|
||||
processAgentMessage :: ACorrId -> ConnId -> AEvent 'AEConn -> CM ()
|
||||
processAgentMessage _ _ (DEL_RCVQS delQs) =
|
||||
toView $ CEvtAgentRcvQueuesDeleted $ L.map rcvQ delQs
|
||||
@@ -141,13 +152,13 @@ processAgentMessage corrId connId msg = do
|
||||
Just (user, entity, gks_) -> processAgentMessageConn cxt user entity gks_ corrId connId msg `catchAllErrors` eToView
|
||||
_ -> throwChatError $ CENoConnectionUser (AgentConnId connId)
|
||||
where
|
||||
getUserEntity :: StoreCxt -> DB.Connection -> ExceptT StoreError IO (Maybe (User, ConnectionEntity, Maybe GroupKeys))
|
||||
getUserEntity :: StoreCxt -> DB.Connection -> ExceptT StoreError IO (Maybe (User, ConnectionEntity, Maybe GroupInfoKeys))
|
||||
getUserEntity cxt db =
|
||||
liftIO (getUserByAConnId db $ AgentConnId connId)
|
||||
>>= mapM (\user -> do
|
||||
(entity, groupKeysData_) <- getConnectionEntityKeys db cxt user (AgentConnId connId)
|
||||
gks_ <- case entity of
|
||||
RcvGroupMsgConnection _ gInfo _ -> mapM (mkGroupKeys db cxt gInfo) groupKeysData_
|
||||
RcvGroupMsgConnection _ gInfo _ -> mapM (mkGroupInfoKeys db cxt gInfo) groupKeysData_
|
||||
_ -> pure Nothing
|
||||
(user,,gks_) <$> liftIO (updateConnStatus db entity))
|
||||
|
||||
@@ -436,7 +447,7 @@ processAgentMsgRcvFile _corrId aFileId msg = do
|
||||
|
||||
type ShouldDeleteGroupConns = Bool
|
||||
|
||||
processAgentMessageConn :: StoreCxt -> User -> ConnectionEntity -> Maybe GroupKeys -> ACorrId -> ConnId -> AEvent 'AEConn -> CM ()
|
||||
processAgentMessageConn :: StoreCxt -> User -> ConnectionEntity -> Maybe GroupInfoKeys -> ACorrId -> ConnId -> AEvent 'AEConn -> CM ()
|
||||
processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId agentMessage =
|
||||
case agentMessage of
|
||||
END -> case entity of
|
||||
@@ -446,8 +457,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
_ -> case entity of
|
||||
RcvDirectMsgConnection conn contact_ ->
|
||||
processDirectMessage agentMessage entity conn contact_
|
||||
RcvGroupMsgConnection conn gInfo m -> case gks_ of
|
||||
Just gks -> processGroupMessage agentMessage entity conn (GIK gInfo gks) m
|
||||
RcvGroupMsgConnection conn _ m -> case gks_ of
|
||||
Just gks -> processGroupMessage agentMessage entity conn gks m
|
||||
Nothing -> throwChatError $ CEInternalError "group connection entity without group keys"
|
||||
UserContactConnection conn uc ->
|
||||
processContactConnMessage agentMessage entity conn uc
|
||||
@@ -501,10 +512,9 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
-- [incognito] send saved profile
|
||||
(conn'', gInfo_) <- saveConnInfo conn' connInfo
|
||||
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
|
||||
profileToSend <-
|
||||
presentUserBadge user incognitoProfile $ case gInfo_ of
|
||||
Just (GIK gInfo _) -> userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile)
|
||||
Nothing -> userProfileDirect user (fromLocalProfile <$> incognitoProfile) Nothing True
|
||||
profileToSend <- case gInfo_ of
|
||||
Just (GIK gInfo _) -> presentUserBadge user incognitoProfile (groupPresHeader gInfo) $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile)
|
||||
Nothing -> presentUserBadgeWith user incognitoProfile (connPresHeader conn'') $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) Nothing True
|
||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
allowAgentConnectionAsync user conn'' confId gInfo_ $ XInfo profileToSend ((\(GIK _ gks) -> groupMemberKey gks) <$> gInfo_)
|
||||
INFO pqSupport connInfo -> do
|
||||
@@ -621,7 +631,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
ct' <- processContactProfileUpdate ct profile False `catchAllErrors` const (pure ct)
|
||||
-- [incognito] send incognito profile
|
||||
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId
|
||||
p <- presentUserBadge user incognitoProfile $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') True
|
||||
p <- presentUserBadgeWith user incognitoProfile (connPresHeader conn'') $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') True
|
||||
allowAgentConnectionAsync user conn'' confId Nothing $ XInfo p Nothing
|
||||
void $ withStore' $ \db -> resetMemberContactFields db ct'
|
||||
XGrpLinkInv glInv -> do
|
||||
@@ -634,7 +644,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart)
|
||||
-- [incognito] send saved profile
|
||||
incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId)
|
||||
profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile)
|
||||
profileToSend <- presentUserBadge user incognitoProfile (groupPresHeader gInfo) $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile)
|
||||
let gks = GKGroup {memberPrivKey = snd memberKeys}
|
||||
allowAgentConnectionAsync user conn'' confId (Just $ GIK gInfo gks) $ XInfo profileToSend (Just $ groupMemberKey gks)
|
||||
toView $ CEvtBusinessLinkConnecting user gInfo host ct
|
||||
@@ -778,17 +788,21 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
_ -> throwChatError $ CECommandError "unexpected cmdFunction"
|
||||
CRContactUri _ _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
|
||||
CONF confId _pqSupport _ connInfo -> do
|
||||
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
|
||||
(signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo
|
||||
conn' <- updatePeerChatVRange conn chatVRange
|
||||
case memberCategory m of
|
||||
GCInviteeMember ->
|
||||
case chatMsgEvent of
|
||||
XGrpAcpt memId mKey
|
||||
XGrpAcpt memId mKey memProfile_
|
||||
| sameMemberId memId m -> do
|
||||
withStore $ \db -> liftIO $ updateGroupMemberStatus db userId m GSMemAccepted
|
||||
forM_ mKey $ \(MemberKey k) -> withStore' $ \db -> setMemberPubKey db (groupMemberId' m) k
|
||||
m' <- case mKey of
|
||||
Just (MemberKey k) -> m {memberPubKey = Just k} <$ withStore' (\db -> setMemberPubKey db (groupMemberId' m) k)
|
||||
Nothing -> pure m
|
||||
membershipProfile <- membershipHandshakeProfile user gInfo
|
||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
allowAgentConnectionAsync user conn' confId (Just g) XOk
|
||||
allowAgentConnectionAsync user conn' confId (Just g) $ XGrpMemInfo (memberId' membership) membershipProfile
|
||||
forM_ memProfile_ $ \memProfile -> processMemberProfileUpdate gInfo m' signedMsg_ memProfile Nothing
|
||||
| otherwise -> messageError "x.grp.acpt: memberId is different from expected"
|
||||
XGrpRelayAcpt relayLink relayCap
|
||||
| memberRole' membership == GROwner && isRelay m -> do
|
||||
@@ -823,7 +837,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
(gInfo', m') <- withStore $ \db -> updatePreparedUserAndHostMembersInvited db cxt user gInfo m glInv
|
||||
-- [incognito] send saved profile
|
||||
incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId)
|
||||
profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo' (fromLocalProfile <$> incognitoProfile)
|
||||
profileToSend <- presentUserBadge user incognitoProfile (groupPresHeader gInfo') $ userProfileInGroup user gInfo' (fromLocalProfile <$> incognitoProfile)
|
||||
allowAgentConnectionAsync user conn' confId (Just $ GIK gInfo' gks) $ XInfo profileToSend (Just $ groupMemberKey gks)
|
||||
toView $ CEvtGroupLinkConnecting user gInfo' m'
|
||||
| otherwise -> messageError "x.grp.link.inv: publicGroupId mismatch"
|
||||
@@ -834,31 +848,32 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
_ -> messageError "CONF from host member in prepared group must have x.grp.link.inv or x.grp.link.reject"
|
||||
_ ->
|
||||
case chatMsgEvent of
|
||||
XGrpMemInfo memId _memProfile
|
||||
XGrpMemInfo memId memProfile
|
||||
| sameMemberId memId m -> do
|
||||
let GroupMember {memberId = membershipMemId} = membership
|
||||
membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
|
||||
-- TODO update member profile
|
||||
membershipProfile <- membershipHandshakeProfile user gInfo
|
||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
allowAgentConnectionAsync user conn' confId (Just g) $ XGrpMemInfo membershipMemId membershipProfile
|
||||
void $ processMemberProfileUpdate gInfo m signedMsg_ memProfile Nothing
|
||||
| otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
|
||||
_ -> messageError "CONF from member must have x.grp.mem.info"
|
||||
INFO _pqSupport connInfo -> do
|
||||
(signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo
|
||||
_conn' <- updatePeerChatVRange conn chatVRange
|
||||
case chatMsgEvent of
|
||||
XGrpMemInfo memId _memProfile
|
||||
| sameMemberId memId m -> do
|
||||
-- TODO update member profile
|
||||
pure ()
|
||||
XGrpMemInfo memId memProfile
|
||||
| sameMemberId memId m ->
|
||||
void $ processMemberProfileUpdate gInfo m signedMsg_ memProfile Nothing
|
||||
| otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
|
||||
-- sent when connecting via group link
|
||||
XInfo _ mKey
|
||||
XInfo memProfile mKey
|
||||
-- TODO Keep rejected member to allow them to appeal against rejection.
|
||||
| memberStatus m == GSMemRejected -> do
|
||||
deleteMemberConnection' m True
|
||||
withStore' $ \db -> deleteGroupMember db user m
|
||||
| otherwise -> mapM_ (storeMemberKey gInfo m signedMsg_) mKey
|
||||
| otherwise -> do
|
||||
m' <- maybe (pure m) (storeMemberKey gInfo m signedMsg_) mKey
|
||||
void $ processMemberProfileUpdate gInfo m' signedMsg_ memProfile Nothing
|
||||
XOk ->
|
||||
-- transient relay-reject row cleanup after the rejection handshake completes
|
||||
when (memberCategory m == GCHostMember && not (relayServesGroup gInfo)) $ do
|
||||
@@ -967,7 +982,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
where
|
||||
sendXGrpLinkMem gInfo'' m' = do
|
||||
let incognitoProfile = ExistingIncognito <$> incognitoMembershipProfile gInfo''
|
||||
profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo'' (fromIncognitoProfile <$> incognitoProfile)
|
||||
profileToSend <- presentUserBadge user incognitoProfile (groupPresHeader gInfo'') $ userProfileInGroup user gInfo'' (fromIncognitoProfile <$> incognitoProfile)
|
||||
sendGroupMemberMessages user (GIK gInfo'' gks) conn [XGrpLinkMem profileToSend (Just $ groupMemberKey gks)]
|
||||
_ -> do
|
||||
unless (memberPending m) $ withStore' $ \db -> updateGroupMemberStatus db userId m GSMemConnected
|
||||
@@ -1092,7 +1107,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
XGrpMemNew memInfo msgScope -> fmap ctx <$> xGrpMemNew (GIK gInfo' gks) m'' memInfo msgScope msg brokerTs
|
||||
XGrpMemIntro memInfo memRestrictions_ -> Nothing <$ xGrpMemIntro gInfo' m'' memInfo memRestrictions_
|
||||
XGrpMemInv memId introInv -> Nothing <$ xGrpMemInv gInfo' m'' memId introInv
|
||||
XGrpMemFwd memInfo introInv -> Nothing <$ xGrpMemFwd gInfo' m'' memInfo introInv
|
||||
XGrpMemFwd memInfo introInv -> Nothing <$ xGrpMemFwd (GIK gInfo' gks) m'' memInfo introInv
|
||||
XGrpMemRole memId memRole memberKey rosterVer -> fmap ctx <$> xGrpMemRole (GIK gInfo' gks) Nothing m'' memId memRole memberKey rosterVer msg brokerTs
|
||||
XGrpMemRestrict memId memRestrictions -> fmap ctx <$> xGrpMemRestrict gInfo' m'' memId memRestrictions msg brokerTs
|
||||
XGrpMemCon memId -> Nothing <$ xGrpMemCon gInfo' m'' memId
|
||||
@@ -1249,11 +1264,11 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
-- Update connection with data derived from cReq, now available after getConnShortLinkAsync
|
||||
withStore' $ \db -> updateConnLinkData db user conn cReq cReqHash groupLinkId chatV pqSup
|
||||
let incognitoProfile = fromLocalProfile <$> incognitoMembershipProfile gInfo
|
||||
profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo incognitoProfile
|
||||
profileToSend <- presentUserBadge user incognitoProfile (groupPresHeader gInfo) $ userProfileInGroup user gInfo incognitoProfile
|
||||
dm <- encodeXMemberConnInfo pqSup g relayMemberId profileToSend
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
(cmdId, connId') <- prepareAgentJoin user (Just conn) True cReq
|
||||
joinAgentConnectionAsync cmdId True connId' True cReq dm subMode
|
||||
cmdId <- withStore' $ \db -> createCommand db user (Just $ dbConnId conn) CFJoinConn
|
||||
joinAgentConnectionAsync cmdId True (aConnId conn) True cReq dm subMode
|
||||
CFGetRelayDataAccept -> do
|
||||
let GroupMember {memberId = MemberId expectedMemberId} = m
|
||||
if linkEntityId == Just expectedMemberId
|
||||
@@ -1393,13 +1408,14 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
|
||||
processContactConnMessage :: AEvent e -> ConnectionEntity -> Connection -> UserContact -> CM ()
|
||||
processContactConnMessage agentMsg connEntity conn UserContact {userContactLinkId = uclId, groupId = ucGroupId_} = case agentMsg of
|
||||
REQ invId pqSupport _ connInfo _ rejectionSupported -> do
|
||||
REQ invId pqSupport _ connInfo binding rejectionSupported -> do
|
||||
(signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo
|
||||
let reqHeader = directPresHeader binding
|
||||
case chatMsgEvent of
|
||||
XContact p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ pqSupport rejectionSupported
|
||||
XContact p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange reqHeader p memberKey_ xContactId_ welcomeMsgId_ requestMsg_ pqSupport rejectionSupported
|
||||
XMember p joiningMemberId joiningMemberKey viaRelay -> memberJoinRequestViaRelay invId chatVRange signedMsg_ p joiningMemberId joiningMemberKey viaRelay
|
||||
XInfo p _ -> profileContactRequest invId chatVRange p Nothing Nothing Nothing Nothing pqSupport rejectionSupported
|
||||
XGrpRelayInv groupRelayInv -> xGrpRelayInv invId chatVRange groupRelayInv
|
||||
XInfo p _ -> profileContactRequest invId chatVRange reqHeader p Nothing Nothing Nothing Nothing pqSupport rejectionSupported
|
||||
XGrpRelayInv groupRelayInv -> xGrpRelayInv invId chatVRange signedMsg_ groupRelayInv
|
||||
XGrpRelayTest challenge _ -> xGrpRelayTest invId chatVRange challenge
|
||||
-- TODO show/log error, other events in contact request
|
||||
_ -> pure ()
|
||||
@@ -1472,8 +1488,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
-- TODO add debugging output
|
||||
_ -> pure ()
|
||||
where
|
||||
profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe MemberKey -> Maybe XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> PQSupport -> Bool -> CM ()
|
||||
profileContactRequest invId chatVRange p@Profile {displayName} memberKey_ xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported = do
|
||||
profileContactRequest :: InvitationId -> VersionRangeChat -> ProofPresHeader -> Profile -> Maybe MemberKey -> Maybe XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> PQSupport -> Bool -> CM ()
|
||||
profileContactRequest invId chatVRange reqHeader p@Profile {displayName} memberKey_ xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported = do
|
||||
(ucl, gLinkInfo_) <- withStore $ \db -> getUserContactLinkById db userId uclId
|
||||
let v = maxVersion chatVRange
|
||||
case gLinkInfo_ of
|
||||
@@ -1483,7 +1499,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
AddressSettings {autoAccept} = addressSettings
|
||||
isSimplexTeam = sameConnReqContact connReq adminContactReq
|
||||
gVar <- asks random
|
||||
withStore (\db -> createOrUpdateContactRequest db gVar cxt user uclId ucl isSimplexTeam invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported) >>= \case
|
||||
withStore (\db -> createOrUpdateContactRequest db gVar cxt user uclId ucl isSimplexTeam invId chatVRange (Just reqHeader) p xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported) >>= \case
|
||||
RSAcceptedRequest _ucr re -> case re of
|
||||
REContact ct ->
|
||||
-- TODO [short links] update request msg
|
||||
@@ -1626,7 +1642,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
maybe (pure $ Right (GAAccepted, gLinkMemRole)) (\am -> liftIO $ am gInfo gli p) acceptMember_ >>= \case
|
||||
Right (acceptance, useRole) -> do
|
||||
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
|
||||
mem <- acceptGroupJoinRequestAsync user uclId g invId chatVRange p xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode memberKey_ Nothing
|
||||
mem <- acceptGroupJoinRequestAsync user uclId g invId chatVRange p (Just reqHeader) xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode memberKey_ Nothing
|
||||
(gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem
|
||||
createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
|
||||
toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem'
|
||||
@@ -1636,16 +1652,21 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
| otherwise -> do
|
||||
mem <- acceptGroupJoinSendRejectAsync user uclId gInfo invId chatVRange p xContactId_ rjctReason
|
||||
toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason
|
||||
xGrpRelayInv :: InvitationId -> VersionRangeChat -> GroupRelayInvitation -> CM ()
|
||||
xGrpRelayInv invId chatVRange groupRelayInv@GroupRelayInvitation {groupLink} = do
|
||||
rejected <- withStore' $ \db -> isRelayGroupRejected db user groupLink
|
||||
initialDelay <- asks $ initialInterval . relayRequestRetryInterval . config
|
||||
if rejected
|
||||
then rejectRelayInvitationAsync user uclId cxt groupRelayInv invId chatVRange initialDelay RRRRejoinRejected
|
||||
else do
|
||||
(_gInfo, _ownerMember) <- withStore $ \db ->
|
||||
createRelayRequestGroup db cxt user groupRelayInv invId chatVRange initialDelay GSMemAccepted RSInvited
|
||||
lift $ void $ getRelayRequestWorker True
|
||||
xGrpRelayInv :: InvitationId -> VersionRangeChat -> Maybe SignedMsg -> GroupRelayInvitation -> CM ()
|
||||
xGrpRelayInv invId chatVRange signedMsg_ groupRelayInv@GroupRelayInvitation {groupLink}
|
||||
| maxVersion chatVRange >= signedRelayInvVersion && isNothing presHeader_ =
|
||||
messageError "x.grp.relay.inv: invitation is not signed by the owner"
|
||||
| otherwise = do
|
||||
rejected <- withStore' $ \db -> isRelayGroupRejected db user groupLink
|
||||
initialDelay <- asks $ initialInterval . relayRequestRetryInterval . config
|
||||
if rejected
|
||||
then rejectRelayInvitationAsync user uclId cxt groupRelayInv presHeader_ invId chatVRange initialDelay RRRRejoinRejected
|
||||
else do
|
||||
(_gInfo, _ownerMember) <- withStore $ \db ->
|
||||
createRelayRequestGroup db cxt user groupRelayInv presHeader_ invId chatVRange initialDelay GSMemAccepted RSInvited
|
||||
lift $ void $ getRelayRequestWorker True
|
||||
where
|
||||
presHeader_ = relayInvPresHeader signedMsg_ groupRelayInv
|
||||
xGrpRelayTest :: InvitationId -> VersionRangeChat -> ByteString -> CM ()
|
||||
xGrpRelayTest invId chatVRange challenge
|
||||
| isTrue userChatRelay && isNothing ucGroupId_ =
|
||||
@@ -1656,7 +1677,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
msg = XGrpRelayTest challenge (Just sig)
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let chatV = vr cxt `peerConnChatVersion` chatVRange
|
||||
(cmdId, acId) <- prepareAgentAccept user True invId PQSupportOff
|
||||
((cmdId, acId), _) <- prepareAgentAccept user True invId PQSupportOff
|
||||
withStore $ \db -> do
|
||||
Connection {connId = testCId} <- createRelayTestConnection db cxt user acId ConnAccepted chatV subMode
|
||||
liftIO $ setCommandConnId db user cmdId testCId
|
||||
@@ -1672,27 +1693,27 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
Just GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
|
||||
g@(GIK gInfo _) <- withStore $ \db -> getGroupInfoKeys db cxt user groupId
|
||||
existing_ <- withStore' $ \db -> eitherToMaybe <$> runExceptT (getGroupMemberByMemberId db cxt user gInfo joiningMemberId)
|
||||
let signed = memberSigned gInfo joiningMemberId joiningKey signedMsg_
|
||||
case existing_ of
|
||||
Just rosterMem
|
||||
-- a privileged memberId's key is owner-authoritative (the roster); the joiner must prove
|
||||
-- possession of that exact key, otherwise this is an attempt to impersonate it
|
||||
| isRosterRole (memberRole' rosterMem) ->
|
||||
if verifyKey gInfo rosterMem
|
||||
then acceptJoin g (Just rosterMem) (memberRole' rosterMem)
|
||||
if verifyKey gInfo rosterMem signed
|
||||
then acceptJoin g signed (Just rosterMem) (memberRole' rosterMem)
|
||||
else messageError "memberJoinRequestViaRelay: rejected join claiming privileged memberId (key mismatch or invalid signature)"
|
||||
_ -> acceptJoin g Nothing gLinkMemRole
|
||||
_ -> acceptJoin g signed Nothing gLinkMemRole
|
||||
Nothing ->
|
||||
messageError "memberJoinRequestViaRelay: no group link info for relay link"
|
||||
where
|
||||
-- replay defense: the viaRelay == own memberId check (viaRelay is in the signed body); without it a sibling relay could replay a privileged member's signed join
|
||||
verifyKey gInfo rosterMem = case signedMsg_ of
|
||||
Just SignedMsg {chatBinding = CBGroup, signatures, signedBody} ->
|
||||
memberPubKey rosterMem == Just joiningKey
|
||||
&& verifyGroupSig joiningKey gInfo joiningMemberId signatures signedBody
|
||||
&& viaRelay == Just (memberId' (membership gInfo))
|
||||
_ -> False
|
||||
acceptJoin g@(GIK gInfo _) existingMem_ acceptRole = do
|
||||
mem <- acceptGroupJoinRequestAsync user uclId g invId chatVRange p Nothing (Just joiningMemberId) Nothing GAAccepted acceptRole Nothing (Just joiningMemberKey) existingMem_
|
||||
verifyKey gInfo rosterMem signed =
|
||||
memberPubKey rosterMem == Just joiningKey
|
||||
&& signed
|
||||
&& viaRelay == Just (memberId' (membership gInfo))
|
||||
acceptJoin g@(GIK gInfo _) signed existingMem_ acceptRole = do
|
||||
let presHeader_ = memberPresHeader gInfo joiningMemberId $ if signed then Just joiningKey else Nothing
|
||||
mem <- acceptGroupJoinRequestAsync user uclId g invId chatVRange p presHeader_ Nothing (Just joiningMemberId) Nothing GAAccepted acceptRole Nothing (Just joiningMemberKey) existingMem_
|
||||
(gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem
|
||||
createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
|
||||
toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem'
|
||||
@@ -2689,13 +2710,13 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
memberKeys <- atomically . C.generateKeyPair =<< asks random
|
||||
(GIK gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership} gks, hostId) <- withStore $ \db -> createGroupInvitation db cxt user ct inv customUserProfileId memberKeys
|
||||
void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart)
|
||||
let GroupMember {groupMemberId, memberId = membershipMemId} = membership
|
||||
let GroupMember {groupMemberId} = membership
|
||||
-- hostContact is only reported for group links, where the client replaces
|
||||
-- the transient host connection view with the group and removes its chat
|
||||
joinGroupAsync hostContact_ sameLink = do
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
dm <- encodeConnInfo $ XGrpAcpt membershipMemId (Just $ groupMemberKey gks)
|
||||
connIds@(cmdId, acId) <- prepareAgentJoin user Nothing True connRequest
|
||||
dm <- encodeXGrpAcpt user (GIK gInfo gks) peerChatVRange
|
||||
(connIds@(cmdId, acId), _) <- prepareAgentJoin user True connRequest
|
||||
withStore' $ \db -> do
|
||||
when sameLink $ setViaGroupLinkUri db groupId connId
|
||||
createMemberConnectionAsync db user hostId connIds connChatVersion peerChatVRange subMode
|
||||
@@ -2756,25 +2777,28 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
brokerTs = metaBrokerTs msgMeta
|
||||
|
||||
processContactProfileUpdate :: Contact -> Profile -> Bool -> CM Contact
|
||||
processContactProfileUpdate c@Contact {profile = lp} p' createItems
|
||||
processContactProfileUpdate c@Contact {profile = lp} p'@Profile {badge = rcvBadge} createItems = do
|
||||
presHeader_ <- if any (not . unboundProof) rcvBadge then pure (contactConn c) $>>= connPresHeader else pure Nothing
|
||||
let p'' = p' {badge = acceptedBadge presHeader_ storedBadge rcvBadge}
|
||||
contentChanged = not (sameProfileContent p p'')
|
||||
-- a failed/unknown-key badge is re-verified even when content is unchanged, so it heals after an app update adds the key
|
||||
| contentChanged || badgeNeedsReverify lp = do
|
||||
c' <- withStore $ \db ->
|
||||
if userTTL == rcvTTL
|
||||
then updateContactProfile db cxt user c p'
|
||||
else do
|
||||
c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
|
||||
updateContactProfile db cxt user c' p'
|
||||
when (contentChanged && directOrUsed c' && createItems) $ do
|
||||
createProfileUpdatedItem c'
|
||||
lift $ createRcvFeatureItems user c c'
|
||||
toView $ CEvtContactUpdated user c c'
|
||||
pure c'
|
||||
| otherwise =
|
||||
pure c
|
||||
if
|
||||
| contentChanged || badgeNeedsReverify lp -> do
|
||||
c' <- withStore $ \db ->
|
||||
if userTTL == rcvTTL
|
||||
then updateContactProfile db cxt user c presHeader_ p'
|
||||
else do
|
||||
c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
|
||||
updateContactProfile db cxt user c' presHeader_ p'
|
||||
when (contentChanged && directOrUsed c' && createItems) $ do
|
||||
createProfileUpdatedItem c' p''
|
||||
lift $ createRcvFeatureItems user c c'
|
||||
toView $ CEvtContactUpdated user c c'
|
||||
pure c'
|
||||
| otherwise ->
|
||||
pure c
|
||||
where
|
||||
contentChanged = not (sameProfileContent p p')
|
||||
p = fromLocalProfile lp
|
||||
p@Profile {badge = storedBadge} = fromLocalProfile lp
|
||||
Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c
|
||||
userTTL = prefParam $ getPreference SCFTimedMessages ctUserPrefs
|
||||
Profile {preferences = rcvPrefs_} = p'
|
||||
@@ -2788,20 +2812,20 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
| rcvTTL /= userDefaultTTL -> Just (userDefault :: TimedMessagesPreference) {ttl = rcvTTL}
|
||||
| otherwise -> Nothing
|
||||
in setPreference_ SCFTimedMessages ctUserTMPref' ctUserPrefs
|
||||
createProfileUpdatedItem c' =
|
||||
createProfileUpdatedItem c' p'' =
|
||||
when visibleProfileUpdated $ do
|
||||
let ciContent = CIRcvDirectEvent $ RDEProfileUpdated p p'
|
||||
let ciContent = CIRcvDirectEvent $ RDEProfileUpdated p p''
|
||||
createInternalChatItem user (CDDirectRcv c') ciContent Nothing
|
||||
where
|
||||
visibleProfileUpdated =
|
||||
n' /= n || fn' /= fn || sd /= sd' || i' /= i || cl' /= cl
|
||||
Profile {displayName = n, fullName = fn, shortDescr = sd, image = i, contactLink = cl} = p
|
||||
Profile {displayName = n', fullName = fn', shortDescr = sd', image = i', contactLink = cl'} = p'
|
||||
Profile {displayName = n', fullName = fn', shortDescr = sd', image = i', contactLink = cl'} = p''
|
||||
|
||||
xInfoMember :: GroupInfo -> GroupMember -> Profile -> Maybe MemberKey -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
|
||||
xInfoMember gInfo m p' mKey msg@RcvMessage {signedMsg_} brokerTs = do
|
||||
mapM_ (storeMemberKey gInfo m signedMsg_) mKey
|
||||
void $ processMemberProfileUpdate gInfo m p' (Just (msg, brokerTs))
|
||||
m' <- maybe (pure m) (storeMemberKey gInfo m signedMsg_) mKey
|
||||
void $ processMemberProfileUpdate gInfo m' signedMsg_ p' (Just (msg, brokerTs))
|
||||
pure $ memberEventDeliveryScope m
|
||||
|
||||
xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> Maybe MemberKey -> RcvMessage -> CM ()
|
||||
@@ -2809,23 +2833,30 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId
|
||||
if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived
|
||||
then do
|
||||
mapM_ (storeMemberKey gInfo m signedMsg_) mKey
|
||||
m' <- processMemberProfileUpdate gInfo m p' Nothing
|
||||
m' <- maybe (pure m) (storeMemberKey gInfo m signedMsg_) mKey
|
||||
m'' <- processMemberProfileUpdate gInfo m' signedMsg_ p' Nothing
|
||||
withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True
|
||||
let connectedIncognito = memberIncognito membership
|
||||
probeMatchingMemberContact m' connectedIncognito
|
||||
probeMatchingMemberContact m'' connectedIncognito
|
||||
else messageError "x.grp.link.mem error: invalid group link host profile update"
|
||||
|
||||
storeMemberKey :: GroupInfo -> GroupMember -> Maybe SignedMsg -> MemberKey -> CM ()
|
||||
storeMemberKey gInfo GroupMember {groupMemberId, memberPubKey, memberId} signedMsg_ (MemberKey k) = case memberPubKey of
|
||||
Just k0 -> when (k /= k0) $ messageError "member key change rejected, keeping current key"
|
||||
storeMemberKey :: GroupInfo -> GroupMember -> Maybe SignedMsg -> MemberKey -> CM GroupMember
|
||||
storeMemberKey gInfo m@GroupMember {groupMemberId, memberPubKey, memberId} signedMsg_ (MemberKey k) = case memberPubKey of
|
||||
Just k0 -> m <$ when (k /= k0) (messageError "member key change rejected, keeping current key")
|
||||
Nothing
|
||||
| signed -> withStore' $ \db -> setMemberPubKey db groupMemberId k
|
||||
| otherwise -> messageError "member key not signed by that key, ignored"
|
||||
| signed -> m {memberPubKey = Just k} <$ withStore' (\db -> setMemberPubKey db groupMemberId k)
|
||||
| otherwise -> m <$ messageError "member key not signed by that key, ignored"
|
||||
where
|
||||
signed = case signedMsg_ of
|
||||
Just SignedMsg {chatBinding = CBGroup, signatures, signedBody} -> verifyGroupSig k gInfo memberId signatures signedBody
|
||||
_ -> False
|
||||
signed = memberSigned gInfo memberId k signedMsg_
|
||||
|
||||
memberSigned :: GroupInfo -> MemberId -> C.PublicKeyEd25519 -> Maybe SignedMsg -> Bool
|
||||
memberSigned gInfo memberId k = \case
|
||||
Just SignedMsg {chatBinding = CBGroup, signatures, signedBody} -> verifyGroupSig k gInfo memberId signatures signedBody
|
||||
_ -> False
|
||||
|
||||
signedMemberPresHeader :: GroupInfo -> GroupMember -> Maybe SignedMsg -> Maybe ProofPresHeader
|
||||
signedMemberPresHeader gInfo GroupMember {memberId, memberPubKey} signedMsg_ =
|
||||
memberPresHeader gInfo memberId $ mfilter (\k -> memberSigned gInfo memberId k signedMsg_) memberPubKey
|
||||
|
||||
xGrpLinkAcpt :: GroupInfoKeys -> GroupMember -> GroupAcceptance -> GroupMemberRole -> MemberId -> RcvMessage -> UTCTime -> CM ()
|
||||
xGrpLinkAcpt g@(GIK gInfo@GroupInfo {membership} _) m acceptance role memberId msg brokerTs
|
||||
@@ -2886,15 +2917,15 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
unless (groupFeatureAllowed SGFHistory gInfo) $ forM_ description $ \descr ->
|
||||
createInternalChatItem user (CDGroupRcv gInfo Nothing m) (CIRcvMsgContent $ MCText descr) Nothing
|
||||
|
||||
processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Maybe (RcvMessage, UTCTime) -> CM GroupMember
|
||||
processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' msgTs_
|
||||
processMemberProfileUpdate :: GroupInfo -> GroupMember -> Maybe SignedMsg -> Profile -> Maybe (RcvMessage, UTCTime) -> CM GroupMember
|
||||
processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId, memberBadgeProof = NoJSON storedMemberProof} signedMsg_ rcvProfile@Profile {badge = rcvBadge} msgTs_
|
||||
-- a failed/unknown-key badge is re-verified even when content is unchanged, so it heals after an app update adds the key
|
||||
| contentChanged || badgeNeedsReverify p = do
|
||||
| contentChanged || badgeNeedsReverify p || memberProofChanged = do
|
||||
when contentChanged $ updateBusinessChatProfile gInfo
|
||||
case memberContactId of
|
||||
Nothing -> do
|
||||
m' <- withStore $ \db -> updateMemberProfile db cxt user m p''
|
||||
unless (muteEventInChannel gInfo m') $ do
|
||||
m' <- withStore $ \db -> updateMemberProfile db cxt user m presHeader_ (redactedMemberProfile gInfo m rcvProfile)
|
||||
unless (muteEventInChannel gInfo m' || noVisibleChange m') $ do
|
||||
when contentChanged $ forM_ msgTs_ $ createProfileUpdatedItem m'
|
||||
toView $ CEvtGroupMemberUpdated user gInfo m m'
|
||||
pure m'
|
||||
@@ -2902,16 +2933,22 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
mCt <- withStore $ \db -> getContact db cxt user mContactId
|
||||
if contactUpdatableFromMember mCt
|
||||
then do
|
||||
(m', ct') <- withStore $ \db -> updateContactMemberProfile db cxt user m mCt p'
|
||||
unless (muteEventInChannel gInfo m') $ do
|
||||
(m', ct') <- withStore $ \db -> updateContactMemberProfile db cxt user m mCt presHeader_ rcvProfile
|
||||
unless (muteEventInChannel gInfo m' || noVisibleChange m') $ do
|
||||
when contentChanged $ forM_ msgTs_ $ createProfileUpdatedItem m'
|
||||
toView $ CEvtGroupMemberUpdated user gInfo m m'
|
||||
toView $ CEvtContactUpdated user mCt ct'
|
||||
pure m'
|
||||
else pure m
|
||||
else withStore' $ \db -> setMemberBadgeProof db cxt m presHeader_ rcvProfile
|
||||
| otherwise =
|
||||
pure m
|
||||
where
|
||||
noVisibleChange m' = not contentChanged && memberBadgeStatus m' == memberBadgeStatus m
|
||||
memberBadgeStatus GroupMember {memberProfile = LocalProfile {localBadge}} = localBadgeStatus <$> localBadge
|
||||
presHeader_ = signedMemberPresHeader gInfo m signedMsg_
|
||||
p' = rcvProfile {badge = acceptedBadge presHeader_ storedProof rcvBadge}
|
||||
memberProofChanged = not $ sameBadgeProof (acceptedBadge presHeader_ storedMemberProof rcvBadge) storedMemberProof
|
||||
Profile {badge = storedProof} = fromLocalProfile p
|
||||
p'' = redactedMemberProfile gInfo m p'
|
||||
contentChanged = not (sameProfileContent (redactedMemberProfile gInfo m (fromLocalProfile p)) p'')
|
||||
updateBusinessChatProfile g@GroupInfo {businessChat} = case businessChat of
|
||||
@@ -3165,8 +3202,9 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo
|
||||
conn' <- updatePeerChatVRange activeConn chatVRange
|
||||
case chatMsgEvent of
|
||||
XInfo p _ -> do
|
||||
ct <- withStore $ \db -> createDirectContact db cxt user conn' p
|
||||
XInfo p@Profile {badge} _ -> do
|
||||
presHeader_ <- if any (not . unboundProof) badge then connPresHeader conn' else pure Nothing
|
||||
ct <- withStore $ \db -> createDirectContact db cxt user conn' presHeader_ p
|
||||
toView $ CEvtContactConnecting user ct
|
||||
pure (conn', Nothing)
|
||||
XGrpLinkInv glInv -> do
|
||||
@@ -3190,6 +3228,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
xGrpMemNew :: GroupInfoKeys -> GroupMember -> MemberInfo -> Maybe MsgScope -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
|
||||
xGrpMemNew (GIK gInfo gks) m memInfo@(MemberInfo memId memRole _ _ assertedKey_) msgScope_ msg brokerTs = do
|
||||
unless (useRelays' gInfo) $ checkHostRole m memRole
|
||||
let presHeader_ = memberInfoPresHeader gInfo memInfo
|
||||
if sameMemberId memId (membership gInfo)
|
||||
then pure Nothing
|
||||
else
|
||||
@@ -3206,7 +3245,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
-- TODO [relays] member: surface relay-key-mismatch as a dedicated event / chat item / relay state
|
||||
when (assertedKey /= memberPubKey unknownMember) $
|
||||
messageWarning $ "x.grp.mem.new: relay asserted key differs from roster-established key, keeping roster key, memberId=" <> safeDecodeUtf8 (strEncode memId)
|
||||
updatedMember <- withStore $ \db -> updateRosterMemberAnnounced db cxt user m unknownMember memInfo initialStatus
|
||||
updatedMember <- withStore $ \db -> updateRosterMemberAnnounced db cxt user m unknownMember memInfo (memberPresHeader gInfo memId (memberPubKey unknownMember)) initialStatus
|
||||
-- roster members can't be pending, so no members-require-attention update
|
||||
gInfo' <- updatePublicGroupData user gInfo gks
|
||||
toView $ CEvtUnknownMemberAnnounced user gInfo' m unknownMember updatedMember
|
||||
@@ -3217,7 +3256,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
messageError "x.grp.mem.new: privileged role not established by roster" $> Nothing
|
||||
| otherwise -> do
|
||||
(updatedMember, gInfo') <- withStore $ \db -> do
|
||||
updatedMember <- updateUnknownMemberAnnounced db cxt user m unknownMember memInfo initialStatus
|
||||
updatedMember <- updateUnknownMemberAnnounced db cxt user m unknownMember memInfo presHeader_ initialStatus
|
||||
gInfo' <-
|
||||
if memberPending updatedMember
|
||||
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
|
||||
@@ -3235,7 +3274,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
| useRelays' gInfo && isPrivilegedRole memRole -> messageError "x.grp.mem.new: privileged member not established by roster" $> Nothing
|
||||
| otherwise -> do
|
||||
(newMember, gInfo') <- withStore $ \db -> do
|
||||
newMember <- createNewGroupMember db cxt user gInfo m memInfo GCPostMember initialStatus
|
||||
newMember <- createNewGroupMember db cxt user gInfo m memInfo presHeader_ GCPostMember initialStatus
|
||||
gInfo' <-
|
||||
if memberPending newMember
|
||||
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
|
||||
@@ -3276,7 +3315,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case
|
||||
Right existingMember
|
||||
| useRelays' gInfo -> do
|
||||
updatedMember <- withStore $ \db -> updatePreparedChannelMember db cxt user existingMember memInfo
|
||||
updatedMember <- withStore $ \db -> updatePreparedChannelMember db cxt user existingMember memInfo (memberPresHeader gInfo memId (memberPubKey existingMember))
|
||||
toView $ CEvtGroupMemberUpdated user gInfo existingMember updatedMember
|
||||
| otherwise ->
|
||||
messageError "x.grp.mem.intro ignored: member already exists"
|
||||
@@ -3289,7 +3328,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
MemberInfo mId mRole v p _
|
||||
| mRole >= GRMember -> MemberInfo mId defaultRole v p Nothing
|
||||
_ -> memInfo
|
||||
void $ withStore $ \db -> createIntroReMember db cxt user gInfo memInfo' memRestrictions
|
||||
void $ withStore $ \db -> createIntroReMember db cxt user gInfo memInfo' (memberInfoPresHeader gInfo memInfo') memRestrictions
|
||||
| otherwise -> do
|
||||
when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c)
|
||||
case memChatVRange of
|
||||
@@ -3299,7 +3338,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
groupConnIds@(cmdId, connId) <- prepareAgentCreation user CFCreateConnGrpMemInv (chatHasNtfs chatSettings) SCMInvitation
|
||||
let chatV = maybe (minVersion (vr cxt)) (\peerVR -> vr cxt `peerConnChatVersion` fromChatVRange peerVR) memChatVRange
|
||||
void $ withStore $ \db -> do
|
||||
reMember <- createIntroReMember db cxt user gInfo memInfo memRestrictions
|
||||
reMember <- createIntroReMember db cxt user gInfo memInfo (memberInfoPresHeader gInfo memInfo) memRestrictions
|
||||
createIntroReMemberConn db user m reMember chatV memInfo groupConnIds subMode
|
||||
withAgent $ \a -> createConnectionAsync a (aCorrId cmdId) connId (chatHasNtfs chatSettings) SCMInvitation CR.IKPQOff True subMode
|
||||
_ -> messageError "x.grp.mem.intro can be only sent by host member"
|
||||
@@ -3320,8 +3359,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
Right reMember -> sendGroupMemberMessage gInfo reMember $ XGrpMemFwd (memberInfo gInfo m) introInv
|
||||
_ -> messageError "x.grp.mem.inv can be only sent by invitee member"
|
||||
|
||||
xGrpMemFwd :: GroupInfo -> GroupMember -> MemberInfo -> IntroInvitation -> CM ()
|
||||
xGrpMemFwd gInfo@GroupInfo {membership, chatSettings} m memInfo@(MemberInfo memId memRole memChatVRange _ _) IntroInvitation {groupConnReq} = do
|
||||
xGrpMemFwd :: GroupInfoKeys -> GroupMember -> MemberInfo -> IntroInvitation -> CM ()
|
||||
xGrpMemFwd g@(GIK gInfo@GroupInfo {membership, chatSettings} _) m memInfo@(MemberInfo memId memRole memChatVRange _ _) IntroInvitation {groupConnReq} = do
|
||||
let GroupMember {memberId = membershipMemId} = membership
|
||||
checkHostRole m memRole
|
||||
toMember <- withStore $ \db -> do
|
||||
@@ -3332,7 +3371,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
-- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that.
|
||||
-- For now, this branch compensates for the lack of delayed message delivery.
|
||||
`catchError` \case
|
||||
SEGroupMemberNotFoundByMemberId _ -> createNewGroupMember db cxt user gInfo m memInfo GCPostMember GSMemAnnounced
|
||||
SEGroupMemberNotFoundByMemberId _ -> createNewGroupMember db cxt user gInfo m memInfo (memberInfoPresHeader gInfo memInfo) GCPostMember GSMemAnnounced
|
||||
e -> throwError e
|
||||
-- TODO [knocking] separate pending statuses from GroupMemberStatus?
|
||||
-- TODO add GSMemIntroInvitedPending, GSMemConnectedPending, etc.?
|
||||
@@ -3341,14 +3380,16 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
liftIO $ updateGroupMemberStatus db userId toMember newMemberStatus
|
||||
pure toMember
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
-- [incognito] send membership incognito profile
|
||||
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
|
||||
let enableNtfsGrp = chatHasNtfs chatSettings
|
||||
groupConnIds@(gCmdId, gAcId) <- prepareAgentJoin user Nothing enableNtfsGrp groupConnReq
|
||||
let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
|
||||
chatV = vr cxt `peerConnChatVersion` mcvr
|
||||
-- [incognito] send membership incognito profile
|
||||
membershipProfile <- membershipHandshakeProfile user gInfo
|
||||
let msg = XGrpMemInfo membershipMemId membershipProfile
|
||||
signing_ = if chatV >= relayWebCapVersion then groupMsgSigning False g msg else Nothing
|
||||
dm <- encodeConnInfoSigning PQSupportOff signing_ msg
|
||||
-- [async agent commands] no continuation needed, but commands should be asynchronous for stability
|
||||
let enableNtfsGrp = chatHasNtfs chatSettings
|
||||
(groupConnIds@(gCmdId, gAcId), _) <- prepareAgentJoin user enableNtfsGrp groupConnReq
|
||||
withStore' $ \db -> createIntroToMemberContact db user m toMember chatV mcvr groupConnIds subMode
|
||||
joinAgentConnectionAsync gCmdId False gAcId enableNtfsGrp groupConnReq dm subMode
|
||||
|
||||
@@ -3874,12 +3915,12 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
}
|
||||
joinExistingContact subMode mCt@Contact {contactId = mContactId}
|
||||
| autoAcceptMemberContacts user = do
|
||||
(cmdId, acId) <- prepareAgentJoin user Nothing True connReq
|
||||
((cmdId, acId), presHeader) <- prepareAgentJoin user True connReq
|
||||
mCt' <- withStore $ \db -> do
|
||||
updateMemberContactInvited db user mCt groupDirectInv
|
||||
void $ liftIO $ createMemberContactConn db user acId (Just cmdId) g mConn ConnJoined mContactId subMode
|
||||
getContact db cxt user mContactId
|
||||
joinMemberContactAsync cmdId acId subMode
|
||||
joinMemberContactAsync cmdId acId presHeader subMode
|
||||
securityCodeChanged mCt'
|
||||
createItems mCt' m
|
||||
| otherwise = do
|
||||
@@ -3893,14 +3934,14 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
createItems mCt' m
|
||||
createNewContact subMode
|
||||
| autoAcceptMemberContacts user = do
|
||||
(cmdId, acId) <- prepareAgentJoin user Nothing True connReq
|
||||
((cmdId, acId), presHeader) <- prepareAgentJoin user True connReq
|
||||
-- [incognito] reuse membership incognito profile
|
||||
(mCt, m') <- withStore $ \db -> do
|
||||
(mContactId, m') <- liftIO $ createMemberContactInvited db user g m groupDirectInv
|
||||
void $ liftIO $ createMemberContactConn db user acId (Just cmdId) g mConn ConnJoined mContactId subMode
|
||||
mCt <- getContact db cxt user mContactId
|
||||
pure (mCt, m')
|
||||
joinMemberContactAsync cmdId acId subMode
|
||||
joinMemberContactAsync cmdId acId presHeader subMode
|
||||
createInternalChatItem user (CDDirectSnd mCt) CIChatBanner (Just epochStart)
|
||||
createItems mCt m'
|
||||
| otherwise = do
|
||||
@@ -3913,9 +3954,9 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
|
||||
createInternalChatItem user (CDDirectSnd mCt) CIChatBanner (Just epochStart)
|
||||
createInternalChatItem user (CDDirectRcv mCt) (CIRcvDirectEvent $ RDEGroupInvLinkReceived gp) Nothing
|
||||
createItems mCt m'
|
||||
joinMemberContactAsync cmdId acId subMode = do
|
||||
joinMemberContactAsync cmdId acId presHeader subMode = do
|
||||
-- [incognito] send membership incognito profile
|
||||
p <- presentUserBadge user (incognitoMembershipProfile g) $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing True
|
||||
p <- presentUserBadge user (incognitoMembershipProfile g) (Just presHeader) $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing True
|
||||
-- TODO PQ should negotitate contact connection with PQSupportOn? (use encodeConnInfoPQ)
|
||||
dm <- encodeConnInfo $ XInfo p Nothing
|
||||
joinAgentConnectionAsync cmdId False acId True connReq dm subMode
|
||||
@@ -4494,22 +4535,23 @@ runRelayRequestWorker a Worker {doWork} = do
|
||||
eToView e
|
||||
processRelayRequest :: GroupId -> RelayRequestData -> CM ()
|
||||
processRelayRequest groupId rrd = do
|
||||
(g@(GIK gInfo _), groupLink_) <- withStore $ \db -> do
|
||||
(g@(GIK gInfo _), groupLink_, ownerMember) <- withStore $ \db -> do
|
||||
g@(GIK gInfo _) <- getGroupInfoKeys db cxt user groupId
|
||||
groupLink_ <- liftIO $ runExceptT $ getGroupLink db user gInfo
|
||||
pure (g, groupLink_)
|
||||
ownerMember <- getHostMember db cxt user groupId
|
||||
pure (g, groupLink_, ownerMember)
|
||||
-- Check if relay link already exists (recovery case)
|
||||
case groupLink_ of
|
||||
Right GroupLink {connLinkContact = CCLink _ sLnk_} ->
|
||||
case sLnk_ of
|
||||
Just sLnk -> acceptOwnerConnection rrd gInfo sLnk
|
||||
Just sLnk -> acceptOwnerConnection rrd gInfo ownerMember sLnk
|
||||
Nothing -> throwChatError $ CEException "processRelayRequest: relay link doesn't have short link"
|
||||
Left _ -> do
|
||||
(gInfo', sLnk) <- getLinkDataCreateRelayLink rrd g
|
||||
acceptOwnerConnection rrd gInfo' sLnk
|
||||
(gInfo', sLnk) <- getLinkDataCreateRelayLink rrd g ownerMember
|
||||
acceptOwnerConnection rrd gInfo' ownerMember sLnk
|
||||
where
|
||||
getLinkDataCreateRelayLink :: RelayRequestData -> GroupInfoKeys -> CM (GroupInfo, ShortLinkContact)
|
||||
getLinkDataCreateRelayLink RelayRequestData {reqGroupLink} (GIK gInfo gks) = do
|
||||
getLinkDataCreateRelayLink :: RelayRequestData -> GroupInfoKeys -> GroupMember -> CM (GroupInfo, ShortLinkContact)
|
||||
getLinkDataCreateRelayLink RelayRequestData {reqGroupLink, reqPublicGroupId} (GIK gInfo gks) GroupMember {memberId = MemberId ownerMemberId, memberPubKey = claimedOwnerKey_} = do
|
||||
memberPrivKey' <- case gks of
|
||||
GKRelayRequest {memberPrivKey} -> pure memberPrivKey
|
||||
_ -> throwChatError $ CEException "getLinkDataCreateRelayLink: group is not a relay request"
|
||||
@@ -4519,8 +4561,10 @@ runRelayRequestWorker a Worker {doWork} = do
|
||||
Just GroupShortLinkData {groupProfile = gp@GroupProfile {publicGroup}} -> do
|
||||
pg <- case (linkEntityId, publicGroup) of
|
||||
(Just entityId, Just pg@PublicGroupProfile {publicGroupId})
|
||||
| B64UrlByteString entityId == publicGroupId -> pure pg
|
||||
_ -> throwChatError $ CEException "getLinkDataCreateRelayLink: linkEntityId does not match profile publicGroupId"
|
||||
| B64UrlByteString entityId == publicGroupId && all (== publicGroupId) reqPublicGroupId -> pure pg
|
||||
_ -> throwChatError $ CEException "getLinkDataCreateRelayLink: linkEntityId does not match publicGroupId of profile or invitation"
|
||||
unless (all (\k -> any (\OwnerAuth {ownerId, ownerKey} -> ownerId == ownerMemberId && ownerKey == k) owners) claimedOwnerKey_) $
|
||||
throwChatError $ CEException "getLinkDataCreateRelayLink: owner key of invitation does not match link data"
|
||||
validateGroupProfile gp
|
||||
sLnk <- createRelayLink gInfo (C.publicKey memberPrivKey', memberPrivKey')
|
||||
gInfo' <- withStore $ \db -> do
|
||||
@@ -4542,7 +4586,7 @@ runRelayRequestWorker a Worker {doWork} = do
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let crClientData = encodeJSON $ CRDataGroup groupLinkId
|
||||
-- prepare link with relayMemId as linkEntityId (no server request)
|
||||
(ccLink, preparedParams) <- withAgent $ \a' -> prepareConnectionLink a' (aUserId user) sigKeys relayMemId True (Just crClientData) CR.IKPQOff False Nothing
|
||||
(ccLink, preparedParams) <- withAgent $ \a' -> prepareConnectionLink a' (aUserId user) SCMContact sigKeys (Just relayMemId) True (Just crClientData) CR.IKPQOff False Nothing
|
||||
ccLink' <- setShortLinkType CCTGroup <$> shortenCreatedLink ccLink
|
||||
sLnk <- case connShortLink' ccLink' of
|
||||
Just sl -> pure sl
|
||||
@@ -4550,12 +4594,11 @@ runRelayRequestWorker a Worker {doWork} = do
|
||||
let userData = encodeShortLinkData $ RelayShortLinkData {relayProfile = fromLocalProfile p}
|
||||
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
|
||||
-- create connection with prepared link (single network call)
|
||||
connId <- withAgent $ \a' -> createConnectionForLink a' NRMBackground (aUserId user) True ccLink preparedParams userLinkData subMode
|
||||
(connId, _) <- withAgent $ \a' -> createConnectionForLink a' NRMBackground (aUserId user) True ccLink preparedParams userLinkData subMode
|
||||
-- TODO [relays] starting role should be communicated in protocol from owner to relays
|
||||
subRole <- asks $ channelSubscriberRole . config
|
||||
void $ withFastStore $ \db -> createGroupLink db gVar user gi connId ccLink' groupLinkId subRole subMode
|
||||
pure sLnk
|
||||
acceptOwnerConnection :: RelayRequestData -> GroupInfo -> ShortLinkContact -> CM ()
|
||||
acceptOwnerConnection RelayRequestData {relayInvId, reqChatVRange} gi relayLink = do
|
||||
ownerMember <- withStore $ \db -> getHostMember db cxt user groupId
|
||||
acceptOwnerConnection :: RelayRequestData -> GroupInfo -> GroupMember -> ShortLinkContact -> CM ()
|
||||
acceptOwnerConnection RelayRequestData {relayInvId, reqChatVRange} gi ownerMember relayLink =
|
||||
void $ acceptRelayJoinRequestAsync user uclId gi ownerMember relayInvId reqChatVRange relayLink
|
||||
|
||||
@@ -92,7 +92,7 @@ import Simplex.Messaging.Version hiding (version)
|
||||
-- This indirection is needed for backward/forward compatibility testing.
|
||||
-- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code.
|
||||
currentChatVersion :: VersionChat
|
||||
currentChatVersion = VersionChat 21
|
||||
currentChatVersion = VersionChat 22
|
||||
|
||||
-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
|
||||
supportedChatVRange :: VersionRangeChat
|
||||
@@ -143,6 +143,9 @@ groupMemberKeyVersion = VersionChat 20
|
||||
anyTextCommandsVersion :: VersionChat
|
||||
anyTextCommandsVersion = VersionChat 21
|
||||
|
||||
signedRelayInvVersion :: VersionChat
|
||||
signedRelayInvVersion = VersionChat 22
|
||||
|
||||
data ConnectionEntity
|
||||
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
|
||||
| RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
|
||||
@@ -468,7 +471,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
|
||||
XMember :: {profile :: Profile, newMemberId :: MemberId, newMemberKey :: MemberKey, viaRelay :: Maybe MemberId} -> ChatMsgEvent 'Json
|
||||
XDirectDel :: ChatMsgEvent 'Json
|
||||
XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
|
||||
XGrpAcpt :: MemberId -> Maybe MemberKey -> ChatMsgEvent 'Json
|
||||
XGrpAcpt :: MemberId -> Maybe MemberKey -> Maybe Profile -> ChatMsgEvent 'Json
|
||||
XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json
|
||||
XGrpLinkReject :: GroupLinkRejection -> ChatMsgEvent 'Json
|
||||
XGrpLinkMem :: Profile -> Maybe MemberKey -> ChatMsgEvent 'Json
|
||||
@@ -1362,6 +1365,7 @@ requiresSignature = \case
|
||||
XGrpRoster_ -> True
|
||||
XInfo_ -> True
|
||||
XGrpLinkMem_ -> True
|
||||
XGrpRelayInv_ -> True
|
||||
_ -> False
|
||||
|
||||
-- | Content events a member may sign (XMsgNew opt-in; XMsgUpdate/XMsgDel when the target was signed).
|
||||
@@ -1441,7 +1445,7 @@ appJsonToCM fwdDepth AppMessageJson {v, msgId, event, params} = do
|
||||
XMember_ -> XMember <$> p "profile" <*> p "newMemberId" <*> p "newMemberKey" <*> opt "viaRelay"
|
||||
XDirectDel_ -> pure XDirectDel
|
||||
XGrpInv_ -> XGrpInv <$> p "groupInvitation"
|
||||
XGrpAcpt_ -> XGrpAcpt <$> p "memberId" <*> opt "memberKey"
|
||||
XGrpAcpt_ -> XGrpAcpt <$> p "memberId" <*> opt "memberKey" <*> opt "profile"
|
||||
XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation"
|
||||
XGrpLinkReject_ -> XGrpLinkReject <$> p "groupLinkRejection"
|
||||
XGrpLinkMem_ -> XGrpLinkMem <$> p "profile" <*> opt "memberKey"
|
||||
@@ -1518,7 +1522,7 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en
|
||||
XMember {profile, newMemberId, newMemberKey, viaRelay} -> o $ ("viaRelay" .=? viaRelay) ["profile" .= profile, "newMemberId" .= newMemberId, "newMemberKey" .= newMemberKey]
|
||||
XDirectDel -> JM.empty
|
||||
XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
|
||||
XGrpAcpt memId memberKey -> o $ ("memberKey" .=? memberKey) ["memberId" .= memId]
|
||||
XGrpAcpt memId memberKey profile -> o $ ("profile" .=? profile) $ ("memberKey" .=? memberKey) ["memberId" .= memId]
|
||||
XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv]
|
||||
XGrpLinkReject groupLinkRjct -> o ["groupLinkRejection" .= groupLinkRjct]
|
||||
XGrpLinkMem profile memberKey -> o $ ("memberKey" .=? memberKey) ["profile" .= profile]
|
||||
|
||||
@@ -31,7 +31,7 @@ import Data.Bitraversable (bitraverse)
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Time.Clock (UTCTime, getCurrentTime)
|
||||
import Simplex.Chat.Badges (rowToBadge)
|
||||
import Simplex.Chat.Badges (MaybeBadgeProofRow, maybeRowToBadgeProof, rowToBadge)
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Store.Direct
|
||||
import Simplex.Chat.Store.Groups
|
||||
@@ -175,23 +175,25 @@ getConnectionEntityKeys db cxt user@User {userId, userContactId} agentConnId = d
|
||||
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.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, p.preferences_json,
|
||||
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_proof, p.contact_domain_verified,
|
||||
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, m.member_security_code, m.member_security_code_verified_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, m.member_security_code, m.member_security_code_verified_at,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
JOIN groups g ON g.group_id = m.group_id
|
||||
JOIN group_profiles gp USING (group_profile_id)
|
||||
JOIN group_members mu ON g.group_id = mu.group_id
|
||||
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ?
|
||||
AND mu.member_status NOT IN (?,?,?)
|
||||
|]
|
||||
(groupMemberId, userId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted)
|
||||
liftIO $ bitraverse (\(g, keysData) -> (,keysData) <$> addGroupChatTags db g) pure gm
|
||||
toGroupAndMember :: UTCTime -> Connection -> GroupInfoRow :. GroupMemberRow -> ((GroupInfo, GroupKeysRow), GroupMember)
|
||||
toGroupAndMember currentTs c (groupInfoRow :. memberRow) =
|
||||
toGroupAndMember :: UTCTime -> Connection -> GroupInfoRow :. GroupMemberRow :. MaybeBadgeProofRow -> ((GroupInfo, GroupKeysRow), GroupMember)
|
||||
toGroupAndMember currentTs c (groupInfoRow :. memberRow :. proofRow) =
|
||||
let groupInfo = toGroupInfo currentTs cxt userContactId [] groupInfoRow
|
||||
member = toGroupMember currentTs userContactId memberRow
|
||||
in (groupInfo, (member :: GroupMember) {activeConn = Just c})
|
||||
in (groupInfo, (member :: GroupMember) {activeConn = Just c, memberBadgeProof = NoJSON $ maybeRowToBadgeProof proofRow})
|
||||
getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact
|
||||
getUserContact_ userContactLinkId = ExceptT $ do
|
||||
userContact_
|
||||
|
||||
@@ -24,7 +24,7 @@ import Control.Monad.IO.Class
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Int (Int64)
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import Simplex.Chat.Badges (badgeToRow, verifyBadge_)
|
||||
import Simplex.Chat.Badges (ProofPresHeader, badgeToRow)
|
||||
import Simplex.Chat.Protocol (MsgContent, businessChatsVersion)
|
||||
import Simplex.Chat.Store.Direct
|
||||
import Simplex.Chat.Store.Groups
|
||||
@@ -57,6 +57,7 @@ createOrUpdateContactRequest ::
|
||||
Bool ->
|
||||
InvitationId ->
|
||||
VersionRangeChat ->
|
||||
Maybe ProofPresHeader ->
|
||||
Profile ->
|
||||
Maybe XContactId ->
|
||||
Maybe SharedMsgId ->
|
||||
@@ -74,7 +75,8 @@ createOrUpdateContactRequest
|
||||
isSimplexTeam
|
||||
invId
|
||||
cReqChatVRange@(VersionRange minV maxV)
|
||||
profile@Profile {displayName, fullName, shortDescr, description, image, contactLink, badge, preferences}
|
||||
presHeader_
|
||||
profile@Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences}
|
||||
xContactId_
|
||||
welcomeMsgId_
|
||||
requestMsg_
|
||||
@@ -94,8 +96,8 @@ createOrUpdateContactRequest
|
||||
Just (gInfo@GroupInfo {businessChat = Just BusinessChatInfo {customerId}}, keysData) -> do
|
||||
clientMember <- getGroupMemberByMemberId db cxt user gInfo customerId
|
||||
cr <- liftIO $ getContactRequestByXContactId xContactId
|
||||
gks <- mkGroupKeys db cxt gInfo keysData
|
||||
pure $ RSAcceptedRequest cr (REBusinessChat (GIK gInfo gks) clientMember)
|
||||
gks <- mkGroupInfoKeys db cxt gInfo keysData
|
||||
pure $ RSAcceptedRequest cr (REBusinessChat gks clientMember)
|
||||
Just (GroupInfo {businessChat = Nothing}, _) -> throwError SEInvalidBusinessChatContactRequest
|
||||
-- 2) if no legacy accepted contact or business chat was found, next we try to find an existing request
|
||||
Nothing ->
|
||||
@@ -167,7 +169,7 @@ createOrUpdateContactRequest
|
||||
createContactRequest :: ExceptT StoreError IO RequestStage
|
||||
createContactRequest = do
|
||||
currentTs <- liftIO $ getCurrentTime
|
||||
badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge
|
||||
(Profile {badge}, badgeVerified) <- liftIO $ profileBadgeVerified presHeader_ (badgeKeys cxt) Nothing profile
|
||||
ExceptT $ withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
|
||||
liftIO $
|
||||
DB.execute
|
||||
@@ -225,7 +227,7 @@ createOrUpdateContactRequest
|
||||
ucr <- getContactRequest db user contactRequestId
|
||||
pure $ RSCurrentRequest Nothing ucr (Just $ REBusinessChat gInfo clientMember)
|
||||
updateContactRequest :: UserContactRequest -> ExceptT StoreError IO RequestStage
|
||||
updateContactRequest ucr@UserContactRequest {contactRequestId, contactId_, localDisplayName = oldLdn, profile = LocalProfile {displayName = oldDisplayName}} = do
|
||||
updateContactRequest ucr@UserContactRequest {contactRequestId, contactId_, localDisplayName = oldLdn, profile = oldProfile@LocalProfile {displayName = oldDisplayName}} = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
liftIO $ updateProfile currentTs
|
||||
updateRequest currentTs
|
||||
@@ -234,7 +236,7 @@ createOrUpdateContactRequest
|
||||
pure $ RSCurrentRequest (Just ucr) ucr' re_
|
||||
where
|
||||
updateProfile currentTs = do
|
||||
badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge
|
||||
(Profile {badge}, badgeVerified) <- profileBadgeVerified presHeader_ (badgeKeys cxt) (Just oldProfile) profile
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
@@ -307,8 +309,8 @@ createOrUpdateContactRequest
|
||||
case gInfo of
|
||||
GroupInfo {businessChat = Just BusinessChatInfo {customerId}} -> do
|
||||
clientMember <- getGroupMemberByMemberId db cxt user gInfo customerId
|
||||
gks <- mkGroupKeys db cxt gInfo keysData
|
||||
pure $ Just (REBusinessChat (GIK gInfo gks) clientMember)
|
||||
gks <- mkGroupInfoKeys db cxt gInfo keysData
|
||||
pure $ Just (REBusinessChat gks clientMember)
|
||||
_ -> throwError SEInvalidBusinessChatContactRequest
|
||||
(Nothing, Nothing) -> pure Nothing
|
||||
_ -> throwError $ SEInvalidContactRequestEntity contactRequestId
|
||||
|
||||
@@ -108,7 +108,7 @@ import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import Data.Text (Text)
|
||||
import Data.Time.Clock (UTCTime (..), getCurrentTime)
|
||||
import Data.Type.Equality
|
||||
import Simplex.Chat.Badges (badgeToRow)
|
||||
import Simplex.Chat.Badges (ProofPresHeader, badgeToRow)
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Store.Shared
|
||||
import Simplex.Chat.Names (SimplexDomainClaim (..))
|
||||
@@ -163,8 +163,8 @@ deletePendingContactConnection db userId connId =
|
||||
|]
|
||||
(userId, connId, ConnContact)
|
||||
|
||||
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> Maybe PreparedChatEntity -> ConnReqContact -> ConnReqUriHash -> Maybe ShortLinkContact -> XContactId -> Maybe IncognitoProfile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO Connection
|
||||
createConnReqConnection db userId acId preparedEntity_ cReq cReqHash sLnk xContactId incognitoProfile groupLinkId subMode chatV pqSup = do
|
||||
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> Maybe PreparedChatEntity -> ConnReqContact -> ProofPresHeader -> ConnReqUriHash -> Maybe ShortLinkContact -> XContactId -> Maybe IncognitoProfile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO Connection
|
||||
createConnReqConnection db userId acId preparedEntity_ cReq presHeader cReqHash sLnk xContactId incognitoProfile groupLinkId subMode chatV pqSup = do
|
||||
currentTs <- getCurrentTime
|
||||
customUserProfileId <- forM incognitoProfile $ \case
|
||||
NewIncognito p -> createIncognitoProfile_ db userId currentTs p
|
||||
@@ -175,13 +175,13 @@ createConnReqConnection db userId acId preparedEntity_ cReq cReqHash sLnk xConta
|
||||
[sql|
|
||||
INSERT INTO connections (
|
||||
user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated,
|
||||
via_contact_uri, via_contact_uri_hash, via_short_link_contact, contact_id, group_member_id,
|
||||
via_contact_uri, pres_header, via_contact_uri_hash, via_short_link_contact, contact_id, group_member_id,
|
||||
xcontact_id, custom_user_profile_id, via_group_link, group_link_id,
|
||||
created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (userId, acId, connStatus, connType, BI True)
|
||||
:. (cReq, cReqHash, sLnk, contactId_, groupMemberId_)
|
||||
:. (cReq, presHeader, cReqHash, sLnk, contactId_, groupMemberId_)
|
||||
:. (xContactId, customUserProfileId, BI (isJust groupLinkId), groupLinkId)
|
||||
:. (currentTs, currentTs, BI (subMode == SMOnlyCreate), chatV, pqSup, pqSup)
|
||||
)
|
||||
@@ -404,12 +404,12 @@ createIncognitoProfile db User {userId} p = do
|
||||
createdAt <- getCurrentTime
|
||||
createIncognitoProfile_ db userId createdAt p
|
||||
|
||||
createPreparedContact :: DB.Connection -> StoreCxt -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> Maybe Bool -> ExceptT StoreError IO Contact
|
||||
createPreparedContact db cxt user p connLinkToConnect welcomeSharedMsgId verified_ = do
|
||||
createPreparedContact :: DB.Connection -> StoreCxt -> User -> Maybe ProofPresHeader -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> Maybe Bool -> ExceptT StoreError IO Contact
|
||||
createPreparedContact db cxt user presHeader_ p connLinkToConnect welcomeSharedMsgId verified_ = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
|
||||
ctUserPreferences = newContactUserPrefs user p
|
||||
ct <- getContact db cxt user =<< createContact_ db cxt user p ctUserPreferences prepared "" currentTs
|
||||
ct <- getContact db cxt user =<< createContact_ db cxt user presHeader_ p ctUserPreferences prepared "" currentTs
|
||||
liftIO $ maybe (pure ct) (setContactDomainVerified db user ct) verified_
|
||||
|
||||
updatePreparedContactUser :: DB.Connection -> StoreCxt -> User -> Contact -> User -> ExceptT StoreError IO Contact
|
||||
@@ -450,11 +450,11 @@ updatePreparedContactUser
|
||||
safeDeleteLDN db user oldLDN
|
||||
getContact db cxt newUser contactId
|
||||
|
||||
createDirectContact :: DB.Connection -> StoreCxt -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
|
||||
createDirectContact db cxt user Connection {connId, localAlias} p = do
|
||||
createDirectContact :: DB.Connection -> StoreCxt -> User -> Connection -> Maybe ProofPresHeader -> Profile -> ExceptT StoreError IO Contact
|
||||
createDirectContact db cxt user Connection {connId, localAlias} presHeader_ p = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let ctUserPreferences = newContactUserPrefs user p
|
||||
contactId <- createContact_ db cxt user p ctUserPreferences Nothing localAlias currentTs
|
||||
contactId <- createContact_ db cxt user presHeader_ p ctUserPreferences Nothing localAlias currentTs
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
|
||||
getContact db cxt user contactId
|
||||
|
||||
@@ -562,23 +562,23 @@ deleteUnusedProfile_ db userId profileId =
|
||||
:. (userId, profileId, userId, profileId, profileId)
|
||||
)
|
||||
|
||||
updateContactProfile :: DB.Connection -> StoreCxt -> User -> Contact -> Profile -> ExceptT StoreError IO Contact
|
||||
updateContactProfile db cxt user@User {userId} c p' = do
|
||||
updateContactProfile :: DB.Connection -> StoreCxt -> User -> Contact -> Maybe ProofPresHeader -> Profile -> ExceptT StoreError IO Contact
|
||||
updateContactProfile db cxt user@User {userId} c presHeader_ p' = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) lp p'
|
||||
(p'', badgeVerified) <- liftIO $ profileBadgeVerified presHeader_ (badgeKeys cxt) (Just lp) claimProfile
|
||||
let nameVerified = if claimChanged then Nothing else prevVerification
|
||||
profile = toLocalProfile profileId p'' localAlias currentTs badgeVerified nameVerified
|
||||
updateContactProfile' currentTs badgeVerified profile
|
||||
updateContactProfile' currentTs p'' badgeVerified profile
|
||||
where
|
||||
Contact {contactId, localDisplayName, profile = lp@LocalProfile {profileId, displayName, localAlias, contactDomain = prevClaim, contactDomainVerified = prevVerification}, userPreferences} = c
|
||||
Profile {displayName = newName, contactDomain, preferences} = p'
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ contactConnIncognito c
|
||||
claimChanged = (domain <$> prevClaim) /= (domain <$> contactDomain)
|
||||
p'' = (p' :: Profile) {contactDomain = (\d -> d {proof = if claimChanged then Nothing else proof =<< prevClaim}) <$> contactDomain}
|
||||
claimProfile = (p' :: Profile) {contactDomain = (\d -> d {proof = if claimChanged then Nothing else proof =<< prevClaim}) <$> contactDomain}
|
||||
clearVerificationIfClaimChanged =
|
||||
when claimChanged $
|
||||
DB.execute db "UPDATE contact_profiles SET contact_domain_verified = NULL WHERE user_id = ? AND contact_profile_id = ?" (userId, profileId)
|
||||
updateContactProfile' currentTs badgeVerified profile
|
||||
updateContactProfile' currentTs p'' badgeVerified profile
|
||||
| displayName == newName = do
|
||||
liftIO $ updateContactProfile_' db userId profileId p'' badgeVerified currentTs
|
||||
liftIO clearVerificationIfClaimChanged
|
||||
|
||||
@@ -193,6 +193,7 @@ module Simplex.Chat.Store.Groups
|
||||
resetMemberContactFields,
|
||||
updateMemberProfile,
|
||||
updateContactMemberProfile,
|
||||
setMemberBadgeProof,
|
||||
getXGrpLinkMemReceived,
|
||||
setXGrpLinkMemReceived,
|
||||
createNewUnknownGroupMember,
|
||||
@@ -230,7 +231,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 (BadgeProof, BadgeRow, ProofPresHeader, acceptedBadge, badgeProofToRow, badgeToRow, sameBadgeProof, verifyBadge)
|
||||
import Simplex.Chat.Names (SimplexDomainClaim (..))
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Operators
|
||||
@@ -597,7 +598,8 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
|
||||
supportChat = Nothing,
|
||||
memberPubKey,
|
||||
relayLink = Nothing,
|
||||
memberVerifiedCode = Nothing
|
||||
memberVerifiedCode = Nothing,
|
||||
memberBadgeProof = NoJSON Nothing
|
||||
}
|
||||
where
|
||||
memberChatVRange@(VersionRange minV maxV) = vr
|
||||
@@ -677,7 +679,7 @@ createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile b
|
||||
randHostId <- liftIO $ encodedRandomBytes gVar 12
|
||||
let memberId = MemberId $ encodeUtf8 groupLDN <> "_unknown_host_" <> randHostId
|
||||
hostProfile = profileFromName $ nameFromBS randHostId
|
||||
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user hostProfile currentTs
|
||||
(localDisplayName, profileId, _, _) <- createNewMemberProfile_ db cxt user hostProfile Nothing currentTs
|
||||
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
|
||||
liftIO $ do
|
||||
DB.execute
|
||||
@@ -834,7 +836,7 @@ updatePreparedUserAndHostMembers'
|
||||
|]
|
||||
(memberId, memberRole, membershipStatus, currentTs, groupMemberId' membership)
|
||||
updateHostMember currentTs = do
|
||||
_ <- updateMemberProfile db cxt user hostMember fromMemberProfile
|
||||
_ <- updateMemberProfile db cxt user hostMember Nothing fromMemberProfile
|
||||
let MemberIdRole memberId memberRole = fromMember
|
||||
gmId = groupMemberId' hostMember
|
||||
liftIO $
|
||||
@@ -885,7 +887,7 @@ createGroupViaLink'
|
||||
(,) <$> getGroupInfo db cxt user groupId <*> getGroupMemberById db cxt user hostMemberId
|
||||
where
|
||||
insertHost_ currentTs groupId = do
|
||||
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user fromMemberProfile currentTs
|
||||
(localDisplayName, profileId, _, _) <- createNewMemberProfile_ db cxt user fromMemberProfile Nothing currentTs
|
||||
let MemberIdRole {memberId, memberRole} = fromMember
|
||||
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
|
||||
liftIO $ do
|
||||
@@ -1412,7 +1414,8 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId,
|
||||
supportChat = Nothing,
|
||||
memberPubKey = Nothing,
|
||||
relayLink = Nothing,
|
||||
memberVerifiedCode = Nothing
|
||||
memberVerifiedCode = Nothing,
|
||||
memberBadgeProof = NoJSON Nothing
|
||||
}
|
||||
where
|
||||
insertMember_ = do
|
||||
@@ -1713,7 +1716,7 @@ createRelayForOwner :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> Gr
|
||||
createRelayForOwner db cxt gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {relayProfile = RelayProfile {displayName}} = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let relayProfile = profileFromName displayName
|
||||
(localDisplayName, memProfileId, _) <- createNewMemberProfile_ db cxt user relayProfile currentTs
|
||||
(localDisplayName, memProfileId, _, _) <- createNewMemberProfile_ db cxt user relayProfile Nothing currentTs
|
||||
groupMemberId <- createWithRandomId' db gVar $ \memId -> runExceptT $ do
|
||||
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
|
||||
liftIO $
|
||||
@@ -1752,7 +1755,7 @@ getCreateRelayForMember db cxt gVar user@User {userId, userContactId} GroupInfo
|
||||
randRelayId <- liftIO $ encodedRandomBytes gVar 12
|
||||
let memberId = MemberId $ encodeUtf8 groupLDN <> "_unknown_relay_" <> randRelayId
|
||||
relayProfile = profileFromName $ nameFromBS randRelayId
|
||||
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user relayProfile currentTs
|
||||
(localDisplayName, profileId, _, _) <- createNewMemberProfile_ db cxt user relayProfile Nothing currentTs
|
||||
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
|
||||
groupMemberId <- liftIO $ do
|
||||
DB.execute
|
||||
@@ -1825,7 +1828,7 @@ setRelayLinkAccepted db cxt user m (MemberKey relayKey) profile = do
|
||||
WHERE group_member_id = ?
|
||||
|]
|
||||
(relayKey, currentTs, gmId)
|
||||
void $ updateMemberProfile db cxt user m profile
|
||||
void $ updateMemberProfile db cxt user m Nothing profile
|
||||
(,) <$> getGroupMemberById db cxt user gmId <*> getGroupRelayByGMId db gmId
|
||||
|
||||
setRelayLinkConfId :: DB.Connection -> GroupMember -> ConfirmationId -> ShortLinkContact -> IO ()
|
||||
@@ -1884,7 +1887,7 @@ updateRelayMemberData db cxt user m memberId (MemberKey relayKey) profile = do
|
||||
WHERE group_member_id = ?
|
||||
|]
|
||||
(memberId, relayKey, currentTs, groupMemberId' m)
|
||||
void $ updateMemberProfile db cxt user m profile
|
||||
void $ updateMemberProfile db cxt user m Nothing profile
|
||||
|
||||
setGroupInProgressDone :: DB.Connection -> GroupInfo -> IO ()
|
||||
setGroupInProgressDone db GroupInfo {groupId} = do
|
||||
@@ -1894,8 +1897,8 @@ setGroupInProgressDone db GroupInfo {groupId} = do
|
||||
"UPDATE groups SET creating_in_progress = 0, updated_at = ? WHERE group_id = ?"
|
||||
(currentTs, groupId)
|
||||
|
||||
createRelayRequestGroup :: DB.Connection -> StoreCxt -> User -> GroupRelayInvitation -> InvitationId -> VersionRangeChat -> Int64 -> GroupMemberStatus -> RelayStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMember, fromMemberProfile, relayMemberId, groupLink} invId reqChatVRange initialDelay memberStatus relayStatus = do
|
||||
createRelayRequestGroup :: DB.Connection -> StoreCxt -> User -> GroupRelayInvitation -> Maybe ProofPresHeader -> InvitationId -> VersionRangeChat -> Int64 -> GroupMemberStatus -> RelayStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMember, fromMemberProfile, relayMemberId, groupLink, publicGroupId, fromMemberKey} presHeader_ invId reqChatVRange initialDelay memberStatus relayStatus = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
-- Create group with placeholder profile
|
||||
let Profile {displayName = fromMemberLDN} = fromMemberProfile
|
||||
@@ -1927,17 +1930,18 @@ createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMemb
|
||||
UPDATE groups
|
||||
SET relay_request_inv_id = ?,
|
||||
relay_request_group_link = ?,
|
||||
relay_request_public_group_id = ?,
|
||||
relay_request_peer_chat_min_version = ?,
|
||||
relay_request_peer_chat_max_version = ?,
|
||||
relay_request_delay = ?,
|
||||
relay_request_execute_at = ?
|
||||
WHERE group_id = ?
|
||||
|]
|
||||
(Binary invId, groupLink, minVersion reqChatVRange, maxVersion reqChatVRange, initialDelay, currentTs, groupId)
|
||||
(Binary invId, groupLink, publicGroupId, minVersion reqChatVRange, maxVersion reqChatVRange, initialDelay, currentTs, groupId)
|
||||
insertOwner_ currentTs groupId = do
|
||||
let MemberIdRole {memberId, memberRole} = fromMember
|
||||
VersionRange minV maxV = reqChatVRange
|
||||
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user fromMemberProfile currentTs
|
||||
(localDisplayName, profileId, Profile {badge}, badgeVerified) <- createNewMemberProfile_ db cxt user fromMemberProfile presHeader_ currentTs
|
||||
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
|
||||
liftIO $ do
|
||||
DB.execute
|
||||
@@ -1946,14 +1950,16 @@ createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMemb
|
||||
INSERT INTO group_members
|
||||
( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
peer_chat_min_version, peer_chat_max_version, member_pub_key)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (groupId, indexInGroup, memberId, memberRole, GCHostMember, memberStatus, Binary B.empty)
|
||||
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
|
||||
:. (minV, maxV)
|
||||
:. (minV, maxV, (\(MemberKey k) -> k) <$> fromMemberKey)
|
||||
)
|
||||
insertedRowId db
|
||||
ownerMemberId <- insertedRowId db
|
||||
forM_ (verifiedProof badgeVerified badge) $ createMemberBadgeProof db ownerMemberId
|
||||
pure ownerMemberId
|
||||
|
||||
updateRelayOwnStatusFromTo :: DB.Connection -> GroupInfo -> RelayStatus -> RelayStatus -> IO GroupInfo
|
||||
updateRelayOwnStatusFromTo db gInfo@GroupInfo {groupId} fromStatus toStatus = do
|
||||
@@ -2020,7 +2026,7 @@ getRelayServedGroups db cxt User {userId, userContactId} = do
|
||||
<> " WHERE g.user_id = ? AND mu.contact_id = ? AND g.relay_own_status IN (?, ?, ?)"
|
||||
)
|
||||
(userId, userContactId, RSAccepted, RSAcknowledgedRoster, RSActive)
|
||||
forM rows $ \(g, keysData) -> GIK g <$> mkGroupKeys db cxt g keysData
|
||||
forM rows $ uncurry (mkGroupInfoKeys db cxt)
|
||||
|
||||
getRelayPublishableGroups :: DB.Connection -> User -> IO [(Int64, B64UrlByteString, Maybe PublicGroupAccess)]
|
||||
getRelayPublishableGroups db User {userId, userContactId} =
|
||||
@@ -2066,7 +2072,7 @@ getRelayInactiveGroups db cxt User {userId, userContactId} ttl = do
|
||||
)
|
||||
(userId, userContactId, RSInactive, cutoffTs)
|
||||
|
||||
createJoiningMember :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> Maybe MemberKey -> ExceptT StoreError IO (GroupMemberId, MemberId)
|
||||
createJoiningMember :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe ProofPresHeader -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> Maybe MemberKey -> ExceptT StoreError IO (GroupMemberId, MemberId)
|
||||
createJoiningMember
|
||||
db
|
||||
cxt
|
||||
@@ -2074,7 +2080,8 @@ createJoiningMember
|
||||
User {userId, userContactId}
|
||||
GroupInfo {groupId, membership}
|
||||
cReqChatVRange
|
||||
Profile {displayName, fullName, shortDescr, description, image, contactLink, badge, preferences}
|
||||
p@Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences}
|
||||
presHeader_
|
||||
cReqXContactId_
|
||||
cReqMemberId_
|
||||
welcomeMsgId_
|
||||
@@ -2082,7 +2089,7 @@ createJoiningMember
|
||||
memberStatus
|
||||
memberKey_ = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge
|
||||
(Profile {badge}, badgeVerified) <- liftIO $ profileBadgeVerified presHeader_ (badgeKeys cxt) Nothing p
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
|
||||
liftIO $
|
||||
DB.execute
|
||||
@@ -2090,7 +2097,7 @@ createJoiningMember
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, contact_link, user_id, 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, preferences, preferences_json) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, description, image, contactLink, userId, currentTs, currentTs) :. badgeToRow badge badgeVerified :. prefsToRow preferences)
|
||||
profileId <- liftIO $ insertedRowId db
|
||||
case cReqMemberId_ of
|
||||
r@(groupMemberId, _) <- case cReqMemberId_ of
|
||||
Just memberId -> do
|
||||
checkMemberNotExists memberId
|
||||
insertMember_ ldn profileId memberId currentTs
|
||||
@@ -2101,6 +2108,8 @@ createJoiningMember
|
||||
insertMember_ ldn profileId (MemberId memId) currentTs
|
||||
groupMemberId <- liftIO $ insertedRowId db
|
||||
pure (groupMemberId, MemberId memId)
|
||||
liftIO $ forM_ (verifiedProof badgeVerified badge) $ createMemberBadgeProof db groupMemberId
|
||||
pure r
|
||||
where
|
||||
VersionRange minV maxV = cReqChatVRange
|
||||
-- TODO [relays] relay: TBC communicate rejection
|
||||
@@ -2416,13 +2425,13 @@ increaseGroupMembersRequireAttention db User {userId} g@GroupInfo {groupId, memb
|
||||
pure g {membersRequireAttention = membersRequireAttention + 1}
|
||||
|
||||
-- | add new member with profile
|
||||
createNewGroupMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
|
||||
createNewGroupMember db cxt user gInfo invitingMember memInfo@MemberInfo {profile} memCategory memStatus = do
|
||||
createNewGroupMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> MemberInfo -> Maybe ProofPresHeader -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
|
||||
createNewGroupMember db cxt user gInfo invitingMember memInfo@MemberInfo {profile} presHeader_ memCategory memStatus = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
(localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user profile currentTs
|
||||
(localDisplayName, memProfileId, memProfile, badgeVerified) <- createNewMemberProfile_ db cxt user profile presHeader_ currentTs
|
||||
let newMember =
|
||||
NewGroupMember
|
||||
{ memInfo,
|
||||
{ memInfo = (memInfo :: MemberInfo) {profile = memProfile},
|
||||
memCategory,
|
||||
memStatus,
|
||||
memRestriction = Nothing,
|
||||
@@ -2434,16 +2443,16 @@ createNewGroupMember db cxt user gInfo invitingMember memInfo@MemberInfo {profil
|
||||
}
|
||||
createNewMember_ db user gInfo newMember badgeVerified currentTs
|
||||
|
||||
createNewMemberProfile_ :: DB.Connection -> StoreCxt -> User -> Profile -> UTCTime -> ExceptT StoreError IO (Text, ProfileId, Maybe Bool)
|
||||
createNewMemberProfile_ db cxt User {userId} Profile {displayName, fullName, shortDescr, description, image, contactLink, badge, preferences} createdAt =
|
||||
createNewMemberProfile_ :: DB.Connection -> StoreCxt -> User -> Profile -> Maybe ProofPresHeader -> UTCTime -> ExceptT StoreError IO (Text, ProfileId, Profile, Maybe Bool)
|
||||
createNewMemberProfile_ db cxt User {userId} p@Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences} presHeader_ createdAt =
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
|
||||
badgeVerified <- verifyBadge_ (badgeKeys cxt) badge
|
||||
(p'@Profile {badge}, badgeVerified) <- profileBadgeVerified presHeader_ (badgeKeys cxt) Nothing p
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, contact_link, user_id, 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, preferences, preferences_json) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((displayName, fullName, shortDescr, description, image, contactLink, userId, createdAt, createdAt) :. badgeToRow badge badgeVerified :. prefsToRow preferences)
|
||||
profileId <- insertedRowId db
|
||||
pure $ Right (ldn, profileId, badgeVerified)
|
||||
pure $ Right (ldn, profileId, p', badgeVerified)
|
||||
|
||||
createNewMember_ :: DB.Connection -> User -> GroupInfo -> NewGroupMember -> Maybe Bool -> UTCTime -> ExceptT StoreError IO GroupMember
|
||||
createNewMember_
|
||||
@@ -2451,7 +2460,7 @@ createNewMember_
|
||||
User {userId, userContactId}
|
||||
GroupInfo {groupId}
|
||||
NewGroupMember
|
||||
{ memInfo = MemberInfo memberId memberRole memChatVRange memberProfile memKey,
|
||||
{ memInfo = MemberInfo memberId memberRole memChatVRange memberProfile@Profile {badge} memKey,
|
||||
memCategory = memberCategory,
|
||||
memStatus = memberStatus,
|
||||
memRestriction,
|
||||
@@ -2467,6 +2476,7 @@ createNewMember_
|
||||
activeConn = Nothing
|
||||
memberChatVRange@(VersionRange minV maxV) = maybe chatInitialVRange fromChatVRange memChatVRange
|
||||
memberPubKey = (\(MemberKey k) -> k) <$> memKey
|
||||
memberProof = verifiedProof badgeVerified badge
|
||||
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
|
||||
liftIO $
|
||||
DB.execute
|
||||
@@ -2485,6 +2495,7 @@ createNewMember_
|
||||
:. (minV, maxV)
|
||||
)
|
||||
groupMemberId <- liftIO $ insertedRowId db
|
||||
liftIO $ forM_ memberProof $ createMemberBadgeProof db groupMemberId
|
||||
pure
|
||||
GroupMember
|
||||
{ groupMemberId,
|
||||
@@ -2509,7 +2520,8 @@ createNewMember_
|
||||
supportChat = Nothing,
|
||||
memberPubKey,
|
||||
relayLink = Nothing,
|
||||
memberVerifiedCode = Nothing
|
||||
memberVerifiedCode = Nothing,
|
||||
memberBadgeProof = NoJSON memberProof
|
||||
}
|
||||
|
||||
checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId)
|
||||
@@ -2614,18 +2626,19 @@ getMemberRelationsVector db GroupMember {groupMemberId} =
|
||||
"SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
|
||||
(Only groupMemberId)
|
||||
|
||||
createIntroReMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberInfo -> Maybe MemberRestrictions -> ExceptT StoreError IO GroupMember
|
||||
createIntroReMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberInfo -> Maybe ProofPresHeader -> Maybe MemberRestrictions -> ExceptT StoreError IO GroupMember
|
||||
createIntroReMember
|
||||
db
|
||||
cxt
|
||||
user
|
||||
gInfo
|
||||
memInfo@(MemberInfo _ _ _ memberProfile _)
|
||||
presHeader_
|
||||
memRestrictions_ = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
(localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user memberProfile currentTs
|
||||
(localDisplayName, memProfileId, memberProfile', badgeVerified) <- createNewMemberProfile_ db cxt user memberProfile presHeader_ currentTs
|
||||
let memRestriction = restriction <$> memRestrictions_
|
||||
newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
|
||||
newMember = NewGroupMember {memInfo = (memInfo :: MemberInfo) {profile = memberProfile'}, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
|
||||
createNewMember_ db user gInfo newMember badgeVerified currentTs
|
||||
|
||||
createIntroReMemberConn :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> MemberInfo -> (CommandId, ConnId) -> SubscriptionMode -> ExceptT StoreError IO GroupMember
|
||||
@@ -3381,25 +3394,26 @@ setMemberContactStartedConnection db Contact {contactId} = do
|
||||
"UPDATE contacts SET grp_direct_inv_started_connection = ?, updated_at = ? WHERE contact_id = ?"
|
||||
(BI True, currentTs, contactId)
|
||||
|
||||
updateMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
|
||||
updateMemberProfile db cxt user m@GroupMember {memberContactId} p' = case memberContactId of
|
||||
Nothing -> updateUnlinkedMemberProfile db cxt user m p'
|
||||
updateMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Maybe ProofPresHeader -> Profile -> ExceptT StoreError IO GroupMember
|
||||
updateMemberProfile db cxt user m@GroupMember {memberContactId} presHeader_ p = case memberContactId of
|
||||
Nothing -> updateUnlinkedMemberProfile db cxt user m presHeader_ p
|
||||
Just ctId -> do
|
||||
ct <- getContact db cxt user ctId
|
||||
if contactUpdatableFromMember ct
|
||||
then fst <$> updateContactMemberProfile db cxt user m ct p'
|
||||
else pure m
|
||||
then fst <$> updateContactMemberProfile db cxt user m ct presHeader_ p
|
||||
else liftIO $ setMemberBadgeProof db cxt m presHeader_ p
|
||||
|
||||
updateUnlinkedMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
|
||||
updateUnlinkedMemberProfile db cxt user@User {userId} m p' = do
|
||||
updateUnlinkedMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Maybe ProofPresHeader -> Profile -> ExceptT StoreError IO GroupMember
|
||||
updateUnlinkedMemberProfile db cxt user@User {userId} m presHeader_ p = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) (memberProfile m) p'
|
||||
(p', badgeVerified) <- liftIO $ profileBadgeVerified presHeader_ (badgeKeys cxt) (Just $ memberProfile m) p
|
||||
let memberProfile = toLocalProfile profileId p' localAlias currentTs badgeVerified Nothing
|
||||
updateMemberProfile' currentTs badgeVerified memberProfile
|
||||
m' <- updateMemberProfile' currentTs p' badgeVerified memberProfile
|
||||
liftIO $ setMemberBadgeProof db cxt m' presHeader_ p
|
||||
where
|
||||
GroupMember {groupMemberId, localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
|
||||
Profile {displayName = newName} = p'
|
||||
updateMemberProfile' currentTs badgeVerified memberProfile
|
||||
Profile {displayName = newName} = p
|
||||
updateMemberProfile' currentTs p' badgeVerified memberProfile
|
||||
| displayName == newName = do
|
||||
liftIO $ updateMemberContactProfileReset_' db userId profileId p' badgeVerified currentTs
|
||||
pure m {memberProfile}
|
||||
@@ -3413,16 +3427,17 @@ updateUnlinkedMemberProfile db cxt user@User {userId} m p' = do
|
||||
safeDeleteLDN db user localDisplayName
|
||||
pure $ Right m {localDisplayName = ldn, memberProfile}
|
||||
|
||||
updateContactMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
|
||||
updateContactMemberProfile db cxt user@User {userId} m ct@Contact {contactId} p' = do
|
||||
updateContactMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Contact -> Maybe ProofPresHeader -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
|
||||
updateContactMemberProfile db cxt user@User {userId} m ct@Contact {contactId} presHeader_ p = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) (memberProfile m) p'
|
||||
(p', badgeVerified) <- liftIO $ profileBadgeVerified presHeader_ (badgeKeys cxt) (Just $ memberProfile m) p
|
||||
let profile = toLocalProfile profileId p' localAlias currentTs badgeVerified Nothing
|
||||
updateContactMemberProfile' currentTs badgeVerified profile
|
||||
(m', ct') <- updateContactMemberProfile' currentTs p' badgeVerified profile
|
||||
(,ct') <$> liftIO (setMemberBadgeProof db cxt m' presHeader_ p)
|
||||
where
|
||||
GroupMember {localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
|
||||
Profile {displayName = newName} = p'
|
||||
updateContactMemberProfile' currentTs badgeVerified profile
|
||||
Profile {displayName = newName} = p
|
||||
updateContactMemberProfile' currentTs p' badgeVerified profile
|
||||
| displayName == newName = do
|
||||
liftIO $ updateMemberContactProfile_' db userId profileId p' badgeVerified currentTs
|
||||
pure (m {memberProfile = profile}, ct {profile} :: Contact)
|
||||
@@ -3432,6 +3447,37 @@ updateContactMemberProfile db cxt user@User {userId} m ct@Contact {contactId} p'
|
||||
updateContactLDN_ db user contactId localDisplayName ldn currentTs
|
||||
pure $ Right (m {localDisplayName = ldn, memberProfile = profile}, ct {localDisplayName = ldn, profile} :: Contact)
|
||||
|
||||
setMemberBadgeProof :: DB.Connection -> StoreCxt -> GroupMember -> Maybe ProofPresHeader -> Profile -> IO GroupMember
|
||||
setMemberBadgeProof db cxt m@GroupMember {groupMemberId, memberBadgeProof = NoJSON storedProof} presHeader_ Profile {badge} = case acceptedBadge presHeader_ storedProof badge of
|
||||
badge' | sameBadgeProof badge' storedProof -> pure m
|
||||
Nothing -> m {memberBadgeProof = NoJSON Nothing} <$ DB.execute db "DELETE FROM group_member_badge_proofs WHERE group_member_id = ?" (Only groupMemberId)
|
||||
Just b ->
|
||||
verifyBadge (badgeKeys cxt) b >>= \case
|
||||
Just True -> m {memberBadgeProof = NoJSON (Just b)} <$ createMemberBadgeProof db groupMemberId b
|
||||
_ -> pure m
|
||||
|
||||
verifiedProof :: Maybe Bool -> Maybe BadgeProof -> Maybe BadgeProof
|
||||
verifiedProof badgeVerified = mfilter (const $ badgeVerified == Just True)
|
||||
|
||||
createMemberBadgeProof :: DB.Connection -> GroupMemberId -> BadgeProof -> IO ()
|
||||
createMemberBadgeProof db groupMemberId badge = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO group_member_badge_proofs (group_member_id, badge_proof, badge_pres_header, badge_key_idx, badge_type, badge_expiry, badge_extra, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?)
|
||||
ON CONFLICT (group_member_id) DO UPDATE SET
|
||||
badge_proof = excluded.badge_proof,
|
||||
badge_pres_header = excluded.badge_pres_header,
|
||||
badge_key_idx = excluded.badge_key_idx,
|
||||
badge_type = excluded.badge_type,
|
||||
badge_expiry = excluded.badge_expiry,
|
||||
badge_extra = excluded.badge_extra,
|
||||
updated_at = excluded.updated_at
|
||||
|]
|
||||
(Only groupMemberId :. badgeProofToRow badge :. (currentTs, currentTs))
|
||||
|
||||
getXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> ExceptT StoreError IO Bool
|
||||
getXGrpLinkMemReceived db mId =
|
||||
ExceptT . firstRow fromOnlyBI (SEGroupMemberNotFound mId) $
|
||||
@@ -3449,7 +3495,7 @@ createNewUnknownGroupMember :: DB.Connection -> StoreCxt -> User -> GroupInfo ->
|
||||
createNewUnknownGroupMember db cxt user@User {userId, userContactId} GroupInfo {groupId} memberId memberName unknownMemberRole = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let memberProfile = profileFromName memberName
|
||||
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user memberProfile currentTs
|
||||
(localDisplayName, profileId, _, _) <- createNewMemberProfile_ db cxt user memberProfile Nothing currentTs
|
||||
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
|
||||
liftIO $
|
||||
DB.execute
|
||||
@@ -3494,7 +3540,7 @@ createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupI
|
||||
where
|
||||
VersionRange minV maxV = vr cxt
|
||||
newOwnerProfile currentTs = do
|
||||
(ldn, pId, _) <- createNewMemberProfile_ db cxt user (profileFromName $ nameFromMemberId memberId) currentTs
|
||||
(ldn, pId, _, _) <- createNewMemberProfile_ db cxt user (profileFromName $ nameFromMemberId memberId) Nothing currentTs
|
||||
pure (ldn, pId)
|
||||
contactNameAndProfile ctId = do
|
||||
Contact {localDisplayName = ldn, profile = LocalProfile {profileId = pId}} <- getContact db cxt user ctId
|
||||
@@ -3503,9 +3549,9 @@ createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupI
|
||||
-- Intro refreshes only profile / status / peer version. Role and key stay owner-authoritative
|
||||
-- (the owner-signed roster for members/moderators/admins, link data for owners), so taking either from
|
||||
-- an in-band relayed intro would let a compromised relay substitute them.
|
||||
updatePreparedChannelMember :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember
|
||||
updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} = do
|
||||
_ <- updateMemberProfile db cxt user member profile
|
||||
updatePreparedChannelMember :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberInfo -> Maybe ProofPresHeader -> ExceptT StoreError IO GroupMember
|
||||
updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} presHeader_ = do
|
||||
_ <- updateMemberProfile db cxt user member presHeader_ profile
|
||||
currentTs <- liftIO getCurrentTime
|
||||
liftIO $
|
||||
DB.execute
|
||||
@@ -3523,9 +3569,9 @@ updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupM
|
||||
where
|
||||
VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
|
||||
|
||||
updateUnknownMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
|
||||
updateUnknownMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile, memberKey} status = do
|
||||
_ <- updateMemberProfile db cxt user unknownMember profile
|
||||
updateUnknownMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> Maybe ProofPresHeader -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
|
||||
updateUnknownMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile, memberKey} presHeader_ status = do
|
||||
_ <- updateMemberProfile db cxt user unknownMember presHeader_ profile
|
||||
currentTs <- liftIO getCurrentTime
|
||||
liftIO $
|
||||
DB.execute
|
||||
@@ -3552,9 +3598,9 @@ updateUnknownMemberAnnounced db cxt user@User {userId} invitingMember unknownMem
|
||||
|
||||
-- Like updateUnknownMemberAnnounced but preserves member_role and member_pub_key
|
||||
-- (roster-established for moderators/admins; the dissemination carries only the profile).
|
||||
updateRosterMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
|
||||
updateRosterMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} status = do
|
||||
_ <- updateMemberProfile db cxt user unknownMember profile
|
||||
updateRosterMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> Maybe ProofPresHeader -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
|
||||
updateRosterMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} presHeader_ status = do
|
||||
_ <- updateMemberProfile db cxt user unknownMember presHeader_ profile
|
||||
currentTs <- liftIO getCurrentTime
|
||||
liftIO $
|
||||
DB.execute
|
||||
|
||||
@@ -53,6 +53,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260904_file_badges
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260915_user_badges
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260918_badge_issue_errors
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260923_preferences_json
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260925_badge_bindings
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Text, Maybe Text)]
|
||||
@@ -105,7 +106,8 @@ schemaMigrations =
|
||||
("20260904_file_badges", m20260904_file_badges, Just down_m20260904_file_badges),
|
||||
("20260915_user_badges", m20260915_user_badges, Just down_m20260915_user_badges),
|
||||
("20260918_badge_issue_errors", m20260918_badge_issue_errors, Just down_m20260918_badge_issue_errors),
|
||||
("20260923_preferences_json", m20260923_preferences_json, Just down_m20260923_preferences_json)
|
||||
("20260923_preferences_json", m20260923_preferences_json, Just down_m20260923_preferences_json),
|
||||
("20260925_badge_bindings", m20260925_badge_bindings, Just down_m20260925_badge_bindings)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -0,0 +1,37 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Store.Postgres.Migrations.M20260925_badge_bindings where
|
||||
|
||||
import Data.Text (Text)
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
m20260925_badge_bindings :: Text
|
||||
m20260925_badge_bindings =
|
||||
[r|
|
||||
ALTER TABLE connections ADD COLUMN pres_header BYTEA;
|
||||
|
||||
ALTER TABLE groups ADD COLUMN relay_request_public_group_id BYTEA;
|
||||
|
||||
CREATE TABLE group_member_badge_proofs(
|
||||
group_member_id BIGINT PRIMARY KEY REFERENCES group_members ON DELETE CASCADE,
|
||||
badge_proof BYTEA NOT NULL,
|
||||
badge_pres_header BYTEA NOT NULL,
|
||||
badge_key_idx BIGINT NOT NULL,
|
||||
badge_type TEXT NOT NULL,
|
||||
badge_expiry TIMESTAMPTZ NOT NULL,
|
||||
badge_extra TEXT NOT NULL,
|
||||
created_at TIMESTAMPTZ NOT NULL,
|
||||
updated_at TIMESTAMPTZ NOT NULL
|
||||
);
|
||||
|]
|
||||
|
||||
down_m20260925_badge_bindings :: Text
|
||||
down_m20260925_badge_bindings =
|
||||
[r|
|
||||
DROP TABLE group_member_badge_proofs;
|
||||
|
||||
ALTER TABLE groups DROP COLUMN relay_request_public_group_id;
|
||||
|
||||
ALTER TABLE connections DROP COLUMN pres_header;
|
||||
|]
|
||||
@@ -618,7 +618,8 @@ CREATE TABLE test_chat_schema.connections (
|
||||
short_link_inv bytea,
|
||||
via_short_link_contact bytea,
|
||||
via_contact_uri bytea,
|
||||
relay_test smallint DEFAULT 0 NOT NULL
|
||||
relay_test smallint DEFAULT 0 NOT NULL,
|
||||
pres_header bytea
|
||||
);
|
||||
|
||||
|
||||
@@ -944,6 +945,20 @@ ALTER TABLE test_chat_schema.files ALTER COLUMN file_id ADD GENERATED ALWAYS AS
|
||||
|
||||
|
||||
|
||||
CREATE TABLE test_chat_schema.group_member_badge_proofs (
|
||||
group_member_id bigint NOT NULL,
|
||||
badge_proof bytea NOT NULL,
|
||||
badge_pres_header bytea NOT NULL,
|
||||
badge_key_idx bigint NOT NULL,
|
||||
badge_type text NOT NULL,
|
||||
badge_expiry timestamp with time zone NOT NULL,
|
||||
badge_extra text NOT NULL,
|
||||
created_at timestamp with time zone NOT NULL,
|
||||
updated_at timestamp with time zone NOT NULL
|
||||
);
|
||||
|
||||
|
||||
|
||||
CREATE TABLE test_chat_schema.group_member_intros (
|
||||
group_member_intro_id bigint NOT NULL,
|
||||
re_group_member_id bigint NOT NULL,
|
||||
@@ -1170,7 +1185,8 @@ CREATE TABLE test_chat_schema.groups (
|
||||
roster_blob bytea,
|
||||
group_domain_verified smallint,
|
||||
stored_roster_version bigint,
|
||||
applied_complete_roster_version bigint
|
||||
applied_complete_roster_version bigint,
|
||||
relay_request_public_group_id bytea
|
||||
);
|
||||
|
||||
|
||||
@@ -1938,6 +1954,11 @@ ALTER TABLE ONLY test_chat_schema.files
|
||||
|
||||
|
||||
|
||||
ALTER TABLE ONLY test_chat_schema.group_member_badge_proofs
|
||||
ADD CONSTRAINT group_member_badge_proofs_pkey PRIMARY KEY (group_member_id);
|
||||
|
||||
|
||||
|
||||
ALTER TABLE ONLY test_chat_schema.group_member_intros
|
||||
ADD CONSTRAINT group_member_intros_pkey PRIMARY KEY (group_member_intro_id);
|
||||
|
||||
@@ -3404,6 +3425,11 @@ ALTER TABLE ONLY test_chat_schema.users
|
||||
|
||||
|
||||
|
||||
ALTER TABLE ONLY test_chat_schema.group_member_badge_proofs
|
||||
ADD CONSTRAINT group_member_badge_proofs_group_member_id_fkey FOREIGN KEY (group_member_id) REFERENCES test_chat_schema.group_members(group_member_id) ON DELETE CASCADE;
|
||||
|
||||
|
||||
|
||||
ALTER TABLE ONLY test_chat_schema.group_member_intros
|
||||
ADD CONSTRAINT group_member_intros_re_group_member_id_fkey FOREIGN KEY (re_group_member_id) REFERENCES test_chat_schema.group_members(group_member_id) ON DELETE CASCADE;
|
||||
|
||||
|
||||
@@ -77,7 +77,7 @@ getNextPendingRelayRequest db =
|
||||
db
|
||||
[sql|
|
||||
SELECT
|
||||
relay_request_inv_id, relay_request_group_link,
|
||||
relay_request_inv_id, relay_request_group_link, relay_request_public_group_id,
|
||||
relay_request_peer_chat_min_version, relay_request_peer_chat_max_version,
|
||||
relay_request_delay, relay_request_retries, created_at, relay_request_execute_at
|
||||
FROM groups
|
||||
@@ -85,10 +85,10 @@ getNextPendingRelayRequest db =
|
||||
|]
|
||||
(Only groupId)
|
||||
where
|
||||
toRelayRequestData :: (Maybe InvitationId, Maybe ShortLinkContact, Maybe VersionChat, Maybe VersionChat, Int64, Int, UTCTime, UTCTime) -> Either StoreError (GroupId, RelayRequestData)
|
||||
toRelayRequestData :: (Maybe InvitationId, Maybe ShortLinkContact, Maybe B64UrlByteString, Maybe VersionChat, Maybe VersionChat, Int64, Int, UTCTime, UTCTime) -> Either StoreError (GroupId, RelayRequestData)
|
||||
toRelayRequestData = \case
|
||||
(Just relayInvId, Just reqGroupLink, Just minV, Just maxV, reqDelay, reqRetries, reqCreatedAt, reqExecuteAt) ->
|
||||
Right (groupId, RelayRequestData {relayInvId, reqGroupLink, reqChatVRange = fromMaybe (versionToRange maxV) $ safeVersionRange minV maxV, reqDelay, reqRetries, reqCreatedAt, reqExecuteAt})
|
||||
(Just relayInvId, Just reqGroupLink, reqPublicGroupId, Just minV, Just maxV, reqDelay, reqRetries, reqCreatedAt, reqExecuteAt) ->
|
||||
Right (groupId, RelayRequestData {relayInvId, reqGroupLink, reqPublicGroupId, reqChatVRange = fromMaybe (versionToRange maxV) $ safeVersionRange minV maxV, reqDelay, reqRetries, reqCreatedAt, reqExecuteAt})
|
||||
_ -> Left $ SEInternalError "missing relay request data"
|
||||
|
||||
updateRelayRequestRetries :: DB.Connection -> GroupId -> Int64 -> UTCTime -> IO ()
|
||||
|
||||
@@ -176,6 +176,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260904_file_badges
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260915_user_badges
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260918_badge_issue_errors
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260923_preferences_json
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260925_badge_bindings
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -351,7 +352,8 @@ schemaMigrations =
|
||||
("20260904_file_badges", m20260904_file_badges, Just down_m20260904_file_badges),
|
||||
("20260915_user_badges", m20260915_user_badges, Just down_m20260915_user_badges),
|
||||
("20260918_badge_issue_errors", m20260918_badge_issue_errors, Just down_m20260918_badge_issue_errors),
|
||||
("20260923_preferences_json", m20260923_preferences_json, Just down_m20260923_preferences_json)
|
||||
("20260923_preferences_json", m20260923_preferences_json, Just down_m20260923_preferences_json),
|
||||
("20260925_badge_bindings", m20260925_badge_bindings, Just down_m20260925_badge_bindings)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -0,0 +1,36 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Store.SQLite.Migrations.M20260925_badge_bindings where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20260925_badge_bindings :: Query
|
||||
m20260925_badge_bindings =
|
||||
[sql|
|
||||
ALTER TABLE connections ADD COLUMN pres_header BLOB;
|
||||
|
||||
ALTER TABLE groups ADD COLUMN relay_request_public_group_id BLOB;
|
||||
|
||||
CREATE TABLE group_member_badge_proofs(
|
||||
group_member_id INTEGER PRIMARY KEY REFERENCES group_members ON DELETE CASCADE,
|
||||
badge_proof BLOB NOT NULL,
|
||||
badge_pres_header BLOB NOT NULL,
|
||||
badge_key_idx INTEGER NOT NULL,
|
||||
badge_type TEXT NOT NULL,
|
||||
badge_expiry TEXT NOT NULL,
|
||||
badge_extra TEXT NOT NULL,
|
||||
created_at TEXT NOT NULL,
|
||||
updated_at TEXT NOT NULL
|
||||
) STRICT;
|
||||
|]
|
||||
|
||||
down_m20260925_badge_bindings :: Query
|
||||
down_m20260925_badge_bindings =
|
||||
[sql|
|
||||
DROP TABLE group_member_badge_proofs;
|
||||
|
||||
ALTER TABLE groups DROP COLUMN relay_request_public_group_id;
|
||||
|
||||
ALTER TABLE connections DROP COLUMN pres_header;
|
||||
|]
|
||||
@@ -1393,7 +1393,7 @@ SEARCH connections USING COVERING INDEX idx_connections_user (user_id=?)
|
||||
|
||||
Query: SELECT conn_id FROM rcv_queues WHERE switch_status = ? AND deleted = 0
|
||||
Plan:
|
||||
SCAN rcv_queues
|
||||
SEARCH rcv_queues USING INDEX idx_rcv_queues_switch_status (switch_status=?)
|
||||
|
||||
Query: SELECT conn_id, rc_verify_code_ad, rc_verify_code_pq, CASE WHEN rc_verify_code_ad IS NULL THEN ratchet_state END FROM ratchets WHERE conn_id = ?
|
||||
Plan:
|
||||
|
||||
@@ -30,6 +30,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -84,6 +85,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -169,13 +171,15 @@ Query:
|
||||
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.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, p.preferences_json,
|
||||
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_proof, p.contact_domain_verified,
|
||||
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, m.member_security_code, m.member_security_code_verified_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, m.member_security_code, m.member_security_code_verified_at,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
JOIN groups g ON g.group_id = m.group_id
|
||||
JOIN group_profiles gp USING (group_profile_id)
|
||||
JOIN group_members mu ON g.group_id = mu.group_id
|
||||
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ?
|
||||
AND mu.member_status NOT IN (?,?,?)
|
||||
|
||||
@@ -186,6 +190,7 @@ SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH gp USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH mu USING INDEX idx_group_members_contact_id (contact_id=?)
|
||||
SEARCH pu USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT delivery_task_id
|
||||
@@ -292,6 +297,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -328,6 +334,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -364,6 +371,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -584,10 +592,11 @@ Query:
|
||||
INSERT INTO group_members
|
||||
( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
peer_chat_min_version, peer_chat_max_version, member_pub_key)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -623,6 +632,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -659,6 +669,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -695,6 +706,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -762,7 +774,7 @@ SEARCH delivery_jobs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
relay_request_inv_id, relay_request_group_link,
|
||||
relay_request_inv_id, relay_request_group_link, relay_request_public_group_id,
|
||||
relay_request_peer_chat_min_version, relay_request_peer_chat_max_version,
|
||||
relay_request_delay, relay_request_retries, created_at, relay_request_execute_at
|
||||
FROM groups
|
||||
@@ -1267,6 +1279,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -1304,6 +1317,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -1897,6 +1911,7 @@ Query:
|
||||
UPDATE groups
|
||||
SET relay_request_inv_id = ?,
|
||||
relay_request_group_link = ?,
|
||||
relay_request_public_group_id = ?,
|
||||
relay_request_peer_chat_min_version = ?,
|
||||
relay_request_peer_chat_max_version = ?,
|
||||
relay_request_delay = ?,
|
||||
@@ -1957,6 +1972,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -1993,6 +2009,7 @@ Query:
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -5010,10 +5027,10 @@ Plan:
|
||||
Query:
|
||||
INSERT INTO connections (
|
||||
user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated,
|
||||
via_contact_uri, via_contact_uri_hash, via_short_link_contact, contact_id, group_member_id,
|
||||
via_contact_uri, pres_header, via_contact_uri_hash, via_short_link_contact, contact_id, group_member_id,
|
||||
xcontact_id, custom_user_profile_id, via_group_link, group_link_id,
|
||||
created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
|
||||
@@ -5068,6 +5085,20 @@ Query:
|
||||
|
||||
Plan:
|
||||
|
||||
Query:
|
||||
INSERT INTO group_member_badge_proofs (group_member_id, badge_proof, badge_pres_header, badge_key_idx, badge_type, badge_expiry, badge_extra, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?)
|
||||
ON CONFLICT (group_member_id) DO UPDATE SET
|
||||
badge_proof = excluded.badge_proof,
|
||||
badge_pres_header = excluded.badge_pres_header,
|
||||
badge_key_idx = excluded.badge_key_idx,
|
||||
badge_type = excluded.badge_type,
|
||||
badge_expiry = excluded.badge_expiry,
|
||||
badge_extra = excluded.badge_extra,
|
||||
updated_at = excluded.updated_at
|
||||
|
||||
Plan:
|
||||
|
||||
Query:
|
||||
INSERT INTO msg_deliveries
|
||||
(message_id, connection_id, agent_msg_id, chat_ts, created_at, updated_at, delivery_status)
|
||||
@@ -5883,10 +5914,12 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
|
||||
WHERE m.group_id = ? AND m.user_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?)
|
||||
AND m.member_status IN (?, ?, ?, ?)
|
||||
@@ -5900,6 +5933,7 @@ LIST SUBQUERY 1
|
||||
SCAN chat_items USING COVERING INDEX idx_chat_items_group_member_id
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -5911,16 +5945,19 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
JOIN group_member_status_predicates sp ON m.member_status = sp.member_status WHERE m.group_id = ? AND m.relay_link = ? AND sp.current_member = 1
|
||||
Plan:
|
||||
SEARCH m USING INDEX idx_group_members_group_id_index_in_group (group_id=?)
|
||||
SEARCH sp USING INDEX sqlite_autoindex_group_member_status_predicates_1 (member_status=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -5932,15 +5969,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?
|
||||
Plan:
|
||||
SEARCH m USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -5952,15 +5992,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.group_id = ? AND m.index_in_group = ?
|
||||
Plan:
|
||||
SEARCH m USING INDEX idx_group_members_group_id_index_in_group (group_id=? AND index_in_group=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -5972,15 +6015,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.group_id = ? AND m.index_in_group = ? AND (m.member_role IN (?,?,?) OR m.group_member_id = ?)
|
||||
Plan:
|
||||
SEARCH m USING INDEX idx_group_members_group_id_index_in_group (group_id=? AND index_in_group=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -5992,15 +6038,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.group_id = ? AND m.member_category = ?
|
||||
Plan:
|
||||
SEARCH m USING INDEX idx_group_members_group_id_index_in_group (group_id=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -6012,15 +6061,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.group_id = ? AND m.member_id = ?
|
||||
Plan:
|
||||
SEARCH m USING INDEX sqlite_autoindex_group_members_1 (group_id=? AND member_id=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -6032,15 +6084,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.group_member_id = ? AND m.user_id = ?
|
||||
Plan:
|
||||
SEARCH m USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -6052,15 +6107,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.group_member_id = ? AND m.user_id = ? AND m.member_status NOT IN (?,?,?,?)
|
||||
Plan:
|
||||
SEARCH m USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -6072,15 +6130,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?)
|
||||
Plan:
|
||||
SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -6092,15 +6153,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role = ?
|
||||
Plan:
|
||||
SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -6112,15 +6176,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?)
|
||||
Plan:
|
||||
SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -6132,15 +6199,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)
|
||||
Plan:
|
||||
SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -6152,15 +6222,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.user_id = ? AND m.group_id = ? AND m.contact_id IS DISTINCT FROM ? AND m.member_role = ?
|
||||
Plan:
|
||||
SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
@@ -6172,15 +6245,18 @@ Query:
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
WHERE m.user_id = ? AND m.removed_at < ?
|
||||
Plan:
|
||||
SEARCH m USING INDEX idx_group_members_user_id (user_id=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
|
||||
SEARCH bp USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT f.file_id, f.ci_file_status, f.file_path
|
||||
@@ -6898,9 +6974,14 @@ SEARCH rcv_files USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH snd_files USING COVERING INDEX idx_snd_files_file_id (file_id=?)
|
||||
SEARCH files USING COVERING INDEX idx_files_redirect_file_id (redirect_file_id=?)
|
||||
|
||||
Query: DELETE FROM group_member_badge_proofs WHERE group_member_id = ?
|
||||
Plan:
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query: DELETE FROM group_members WHERE member_id = ?
|
||||
Plan:
|
||||
SCAN group_members
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -6932,6 +7013,7 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta
|
||||
Query: DELETE FROM group_members WHERE user_id = ? AND group_id = ?
|
||||
Plan:
|
||||
SEARCH group_members USING COVERING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -6963,6 +7045,7 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta
|
||||
Query: DELETE FROM group_members WHERE user_id = ? AND group_member_id = ?
|
||||
Plan:
|
||||
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH group_member_badge_proofs USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
|
||||
@@ -7345,6 +7428,10 @@ Query: SELECT accepted_at FROM operator_usage_conditions WHERE server_operator_i
|
||||
Plan:
|
||||
SEARCH operator_usage_conditions USING INDEX idx_operator_usage_conditions_conditions_commit (conditions_commit=? AND server_operator_id=?)
|
||||
|
||||
Query: SELECT agent_conn_id FROM connections
|
||||
Plan:
|
||||
SCAN connections USING COVERING INDEX sqlite_autoindex_connections_1
|
||||
|
||||
Query: SELECT agent_conn_id FROM connections WHERE user_id = ? AND conn_req_inv IN (?,?) LIMIT 1
|
||||
Plan:
|
||||
SEARCH connections USING INDEX idx_connections_conn_req_inv (user_id=? AND conn_req_inv=?)
|
||||
@@ -7808,7 +7895,7 @@ Query: SELECT user_id FROM users WHERE local_display_name = ?
|
||||
Plan:
|
||||
SEARCH users USING COVERING INDEX sqlite_autoindex_users_2 (local_display_name=?)
|
||||
|
||||
Query: SELECT via_contact_uri FROM connections WHERE connection_id = ?
|
||||
Query: SELECT via_contact_uri, pres_header FROM connections WHERE connection_id = ?
|
||||
Plan:
|
||||
SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
@@ -8056,6 +8143,10 @@ Query: UPDATE group_members SET member_profile_id = ?, updated_at = ? WHERE grou
|
||||
Plan:
|
||||
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query: UPDATE group_members SET member_pub_key = ? WHERE member_category = 'user'
|
||||
Plan:
|
||||
SCAN group_members
|
||||
|
||||
Query: UPDATE group_members SET member_pub_key = ?, member_role = ?, updated_at = ? WHERE group_member_id = ?
|
||||
Plan:
|
||||
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
|
||||
@@ -8112,6 +8203,10 @@ Query: UPDATE group_profiles SET description = ? WHERE display_name = ?
|
||||
Plan:
|
||||
SCAN group_profiles
|
||||
|
||||
Query: UPDATE group_profiles SET public_group_id = ?
|
||||
Plan:
|
||||
SCAN group_profiles
|
||||
|
||||
Query: UPDATE group_relays SET relay_status = ?, updated_at = ? WHERE group_relay_id = ?
|
||||
Plan:
|
||||
SEARCH group_relays USING INTEGER PRIMARY KEY (rowid=?)
|
||||
@@ -8168,6 +8263,10 @@ Query: UPDATE groups SET local_display_name = ?, updated_at = ? WHERE user_id =
|
||||
Plan:
|
||||
SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query: UPDATE groups SET member_priv_key = ?
|
||||
Plan:
|
||||
SCAN groups
|
||||
|
||||
Query: UPDATE groups SET member_priv_key = NULL
|
||||
Plan:
|
||||
SCAN groups
|
||||
@@ -8272,6 +8371,10 @@ Query: UPDATE usage_conditions SET notified_at = ? WHERE usage_conditions_id = ?
|
||||
Plan:
|
||||
SEARCH usage_conditions USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query: UPDATE user_contact_links SET short_link_contact = NULL
|
||||
Plan:
|
||||
SCAN user_contact_links
|
||||
|
||||
Query: UPDATE users SET active_user = 0
|
||||
Plan:
|
||||
SCAN users
|
||||
|
||||
@@ -211,7 +211,8 @@ CREATE TABLE groups(
|
||||
roster_blob BLOB,
|
||||
group_domain_verified INTEGER,
|
||||
stored_roster_version INTEGER,
|
||||
applied_complete_roster_version INTEGER, -- received
|
||||
applied_complete_roster_version INTEGER,
|
||||
relay_request_public_group_id BLOB, -- received
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
@@ -390,6 +391,7 @@ CREATE TABLE connections(
|
||||
via_short_link_contact BLOB,
|
||||
via_contact_uri BLOB,
|
||||
relay_test INTEGER NOT NULL DEFAULT 0,
|
||||
pres_header BLOB,
|
||||
FOREIGN KEY(snd_file_id, connection_id)
|
||||
REFERENCES snd_files(file_id, connection_id)
|
||||
ON DELETE CASCADE
|
||||
@@ -981,6 +983,17 @@ CREATE TABLE badge_code_redemptions(
|
||||
created_at TEXT NOT NULL,
|
||||
UNIQUE(user_id, code)
|
||||
) STRICT;
|
||||
CREATE TABLE group_member_badge_proofs(
|
||||
group_member_id INTEGER PRIMARY KEY REFERENCES group_members ON DELETE CASCADE,
|
||||
badge_proof BLOB NOT NULL,
|
||||
badge_pres_header BLOB NOT NULL,
|
||||
badge_key_idx INTEGER NOT NULL,
|
||||
badge_type TEXT NOT NULL,
|
||||
badge_expiry TEXT NOT NULL,
|
||||
badge_extra TEXT NOT NULL,
|
||||
created_at TEXT NOT NULL,
|
||||
updated_at TEXT NOT NULL
|
||||
) STRICT;
|
||||
CREATE INDEX contact_profiles_index ON contact_profiles(
|
||||
display_name,
|
||||
full_name
|
||||
|
||||
@@ -32,7 +32,7 @@ import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Clock (UTCTime (..), getCurrentTime)
|
||||
import Data.Type.Equality
|
||||
import Simplex.Chat.Badges (BadgeRow, badgeToRow, rowToBadge, verifyBadge_)
|
||||
import Simplex.Chat.Badges (BadgeRow, MaybeBadgeProofRow, ProofPresHeader, badgeToRow, maybeRowToBadgeProof, rowToBadge)
|
||||
import Simplex.Chat.Names (SimplexDomainProof, SimplexDomainClaim (..), claimDomain)
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Remote.Types
|
||||
@@ -414,12 +414,12 @@ setCommandConnId db User {userId} cmdId connId = do
|
||||
createContact :: DB.Connection -> StoreCxt -> User -> Profile -> ExceptT StoreError IO ()
|
||||
createContact db cxt user profile = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
void $ createContact_ db cxt user profile emptyChatPrefs Nothing "" currentTs
|
||||
void $ createContact_ db cxt user Nothing profile emptyChatPrefs Nothing "" currentTs
|
||||
|
||||
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, description, image, contactLink, contactDomain, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs =
|
||||
createContact_ :: DB.Connection -> StoreCxt -> User -> Maybe ProofPresHeader -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> ExceptT StoreError IO ContactId
|
||||
createContact_ db cxt User {userId} presHeader_ p@Profile {displayName, fullName, shortDescr, description, image, contactLink, contactDomain, peerType, preferences} ctUserPreferences prepared localAlias currentTs =
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
|
||||
badgeVerified <- verifyBadge_ (badgeKeys cxt) badge
|
||||
(Profile {badge}, badgeVerified) <- profileBadgeVerified presHeader_ (badgeKeys cxt) Nothing p
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, contact_link, chat_peer_type, user_id, local_alias, 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, preferences, preferences_json) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
@@ -589,12 +589,12 @@ getConnReqInv db connId =
|
||||
"SELECT conn_req_inv FROM connections WHERE connection_id = ?"
|
||||
(Only connId)
|
||||
|
||||
getConnReqContact :: DB.Connection -> Int64 -> ExceptT StoreError IO ConnReqContact
|
||||
getConnReqContact :: DB.Connection -> Int64 -> ExceptT StoreError IO (ConnReqContact, Maybe ProofPresHeader)
|
||||
getConnReqContact db connId =
|
||||
ExceptT . firstRow fromOnly (SEConnectionNotFoundById connId) $
|
||||
ExceptT . firstRow id (SEConnectionNotFoundById connId) $
|
||||
DB.query
|
||||
db
|
||||
"SELECT via_contact_uri FROM connections WHERE connection_id = ?"
|
||||
"SELECT via_contact_uri, pres_header FROM connections WHERE connection_id = ?"
|
||||
(Only connId)
|
||||
|
||||
-- | Saves unique local display name based on passed displayName, suffixed with _N if required.
|
||||
@@ -747,14 +747,15 @@ toPublicGroupAccess (groupWebPage, groupDomain_, domainWebPage_, allowEmbedding_
|
||||
domainWebPage = maybe False unBI domainWebPage_
|
||||
allowEmbedding = maybe False unBI allowEmbedding_
|
||||
|
||||
mkGroupKeys :: DB.Connection -> StoreCxt -> GroupInfo -> GroupKeysRow -> ExceptT StoreError IO GroupKeys
|
||||
mkGroupKeys db cxt g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup}, membership} (rootPrivKey, rootPubKey, memberPrivKey_) = do
|
||||
mkGroupInfoKeys :: DB.Connection -> StoreCxt -> GroupInfo -> GroupKeysRow -> ExceptT StoreError IO GroupInfoKeys
|
||||
mkGroupInfoKeys db cxt g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup}, membership} (rootPrivKey, rootPubKey, memberPrivKey_) = do
|
||||
memberPrivKey <- case memberPrivKey_ of
|
||||
Just k -> pure k
|
||||
Nothing -> do
|
||||
(_, k) <- atomically $ C.generateKeyPair (drg cxt)
|
||||
setUserMemberKey db groupId (groupMemberId' membership) k
|
||||
pure $ case (useRelays' g, isJust publicGroup, GRKPrivate <$> rootPrivKey <|> GRKPublic <$> rootPubKey) of
|
||||
let membership' = membership {memberPubKey = Just $ C.publicKey memberPrivKey} :: GroupMember
|
||||
pure $ GIK g {membership = membership'} $ case (useRelays' g, isJust publicGroup, GRKPrivate <$> rootPrivKey <|> GRKPublic <$> rootPubKey) of
|
||||
(False, _, _) -> GKGroup {memberPrivKey}
|
||||
(True, True, Just groupRootKey) -> GKPublicGroup {groupRootKey, memberPrivKey}
|
||||
(True, True, Nothing) -> GKPreparedPublicGroup {memberPrivKey}
|
||||
@@ -785,6 +786,7 @@ toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId
|
||||
invitedBy = toInvitedBy userContactId invitedById
|
||||
activeConn = Nothing
|
||||
memberVerifiedCode = SecurityCode <$> memberCode_ <*> memberCodeVerifiedAt_
|
||||
memberBadgeProof = NoJSON Nothing
|
||||
memberChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
|
||||
supportChat = case supportChatTs_ of
|
||||
Just chatTs ->
|
||||
@@ -811,15 +813,17 @@ groupMemberQuery =
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
bp.badge_proof, bp.badge_pres_header, bp.badge_key_idx, bp.badge_type, bp.badge_expiry, bp.badge_extra
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|
||||
LEFT JOIN group_member_badge_proofs bp ON bp.group_member_id = m.group_member_id
|
||||
|]
|
||||
|
||||
toContactMember :: UTCTime -> StoreCxt -> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
|
||||
toContactMember now cxt User {userContactId} (memberRow :. connRow) =
|
||||
(toGroupMember now userContactId memberRow) {activeConn = toMaybeConnection cxt connRow}
|
||||
toContactMember :: UTCTime -> StoreCxt -> User -> (GroupMemberRow :. MaybeConnectionRow :. MaybeBadgeProofRow) -> GroupMember
|
||||
toContactMember now cxt User {userContactId} (memberRow :. connRow :. proofRow) =
|
||||
(toGroupMember now userContactId memberRow) {activeConn = toMaybeConnection cxt connRow, memberBadgeProof = NoJSON $ maybeRowToBadgeProof proofRow}
|
||||
|
||||
rowToLocalProfile :: UTCTime -> ProfileRow -> LocalProfile
|
||||
rowToLocalProfile now ((profileId, displayName, fullName, shortDescr, description, image, contactLink, peerType, localAlias, encodedPrefs, receivedPrefs) :. badgeRow :. domainRow) =
|
||||
@@ -938,11 +942,7 @@ addGroupChatTags db g@GroupInfo {groupId} = do
|
||||
pure (g :: GroupInfo) {chatTags}
|
||||
|
||||
getGroupInfoKeys :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO GroupInfoKeys
|
||||
getGroupInfoKeys db cxt user groupId = do
|
||||
(g@GroupInfo {membership}, keysData) <- getGroupInfoRow db cxt user groupId
|
||||
gks <- mkGroupKeys db cxt g keysData
|
||||
let membership' = membership {memberPubKey = Just $ C.publicKey $ memberPrivKey gks} :: GroupMember
|
||||
pure $ GIK (g :: GroupInfo) {membership = membership'} gks
|
||||
getGroupInfoKeys db cxt user groupId = uncurry (mkGroupInfoKeys db cxt) =<< getGroupInfoRow db cxt user groupId
|
||||
|
||||
getGroupInfo :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO GroupInfo
|
||||
getGroupInfo db cxt user groupId = fst <$> getGroupInfoRow db cxt user groupId
|
||||
|
||||
@@ -54,7 +54,7 @@ import Data.Time.Clock (UTCTime)
|
||||
import Data.Type.Equality (testEquality, (:~:) (Refl))
|
||||
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 (..), LocalBadge (..), ProofPresHeader, acceptedBadge, localBadgeInfo, localBadgeStatus, mkBadgeStatus, verifyBadge)
|
||||
import Simplex.Chat.Names (SimplexDomainClaim (..))
|
||||
import Simplex.Messaging.Crypto.BBS (BBSPublicKey)
|
||||
import Simplex.Chat.Types.Preferences
|
||||
@@ -855,15 +855,18 @@ fromLocalProfile LocalProfile {displayName, fullName, shortDescr, description, i
|
||||
OwnBadge _ _ -> Nothing -- the own credential is not sent, proof is generated on send
|
||||
ShownBadge _ _ -> Nothing -- a display-only badge is not sent
|
||||
|
||||
profileBadgeVerified :: Map Int BBSPublicKey -> LocalProfile -> Profile -> IO (Maybe Bool)
|
||||
profileBadgeVerified keys LocalProfile {localBadge} Profile {badge = newBadge} =
|
||||
case (localBadge, newBadge) of
|
||||
profileBadgeVerified :: Maybe ProofPresHeader -> Map Int BBSPublicKey -> Maybe LocalProfile -> Profile -> IO (Profile, Maybe Bool)
|
||||
profileBadgeVerified expected keys lp_ p@Profile {badge = rcvBadge} =
|
||||
(,) p {badge = newBadge} <$> case (storedBadge, newBadge) of
|
||||
(_, Nothing) -> pure (Just False)
|
||||
-- an unchanged badge that verified before stays verified; failed or unknown-key badges
|
||||
-- are re-verified, so an unknown key heals once an app update adds it
|
||||
(Just lb, Just (BadgeProof _ _ _ newInfo))
|
||||
| localBadgeInfo lb == newInfo && localBadgeStatus lb `notElem` [BSFailed, BSUnknownKey] -> pure (Just True)
|
||||
(_, Just newB) -> verifyBadge keys newB
|
||||
where
|
||||
storedBadge = (\LocalProfile {localBadge} -> localBadge) =<< lp_
|
||||
newBadge = acceptedBadge expected ((\Profile {badge} -> badge) . fromLocalProfile =<< lp_) rcvBadge
|
||||
|
||||
-- a failed or unknown-key badge is re-verified on the next profile update even when its disclosed content
|
||||
-- is unchanged, so it heals once an app update adds the issuer key
|
||||
@@ -1007,7 +1010,9 @@ data GroupRelayInvitation = GroupRelayInvitation
|
||||
{ fromMember :: MemberIdRole,
|
||||
fromMemberProfile :: Profile,
|
||||
relayMemberId :: MemberId,
|
||||
groupLink :: ShortLinkContact
|
||||
groupLink :: ShortLinkContact,
|
||||
publicGroupId :: Maybe B64UrlByteString,
|
||||
fromMemberKey :: Maybe MemberKey
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -1210,13 +1215,15 @@ data GroupMember = GroupMember
|
||||
relayLink :: Maybe ShortLinkContact,
|
||||
-- out-of-band verified security code for connectionless (channel) members;
|
||||
-- regular members carry it in activeConn instead (see memberSecurityCode)
|
||||
memberVerifiedCode :: Maybe SecurityCode
|
||||
memberVerifiedCode :: Maybe SecurityCode,
|
||||
memberBadgeProof :: NoJSON BadgeProof
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data RelayRequestData = RelayRequestData
|
||||
{ relayInvId :: InvitationId,
|
||||
reqGroupLink :: ShortLinkContact,
|
||||
reqPublicGroupId :: Maybe B64UrlByteString,
|
||||
reqChatVRange :: VersionRangeChat,
|
||||
reqDelay :: Int64,
|
||||
reqRetries :: Int,
|
||||
|
||||
@@ -151,20 +151,22 @@ setPreference_ f pref_ prefs =
|
||||
SCFCalls -> prefs {calls = pref_}
|
||||
SCFSessions -> prefs {sessions = pref_}
|
||||
|
||||
newtype PrefsJSON = PrefsJSON {unPrefsJSON :: Maybe Object}
|
||||
newtype NoJSON a = NoJSON {unNoJSON :: Maybe a}
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance ToJSON PrefsJSON where
|
||||
instance ToJSON (NoJSON a) where
|
||||
toJSON _ = Null
|
||||
toEncoding _ = JE.null_
|
||||
omitField _ = True
|
||||
|
||||
instance FromJSON PrefsJSON where
|
||||
parseJSON _ = pure $ PrefsJSON Nothing
|
||||
omittedField = Just $ PrefsJSON Nothing
|
||||
instance FromJSON (NoJSON a) where
|
||||
parseJSON _ = pure $ NoJSON Nothing
|
||||
omittedField = Just $ NoJSON Nothing
|
||||
|
||||
type PrefsJSON = NoJSON Object
|
||||
|
||||
keepPrefsJSON :: (ToJSON p, HasField "_json" p PrefsJSON) => Value -> p -> p
|
||||
keepPrefsJSON v ps = setField @"_json" ps . PrefsJSON $ case v of
|
||||
keepPrefsJSON v ps = setField @"_json" ps . NoJSON $ case v of
|
||||
Object o | v /= toJSON ps -> Just o
|
||||
_ -> Nothing
|
||||
|
||||
@@ -177,7 +179,7 @@ prefsFromRow_ prefsP encodedPrefs receivedPrefs = (decode =<< receivedPrefs) <|>
|
||||
decode = decodePrefs prefsP
|
||||
|
||||
prefsToRow :: HasField "_json" p PrefsJSON => Maybe p -> (Maybe p, Maybe Text)
|
||||
prefsToRow ps = (ps, encodeJSON . Object <$> (unPrefsJSON . getField @"_json" =<< ps))
|
||||
prefsToRow ps = (ps, encodeJSON . Object <$> (unNoJSON . getField @"_json" =<< ps))
|
||||
|
||||
-- collection of optional chat preferences for the user and the contact
|
||||
data Preferences = Preferences
|
||||
@@ -545,7 +547,7 @@ toChatPrefs FullPreferences {timedMessages, fullDelete, reactions, voice, files,
|
||||
calls = Just calls,
|
||||
sessions = Just sessions,
|
||||
commands = Just cmds,
|
||||
_json = PrefsJSON Nothing
|
||||
_json = NoJSON Nothing
|
||||
}
|
||||
|
||||
defaultChatPrefs :: FullPreferences
|
||||
@@ -562,7 +564,7 @@ defaultChatPrefs =
|
||||
}
|
||||
|
||||
emptyChatPrefs :: Preferences
|
||||
emptyChatPrefs = Preferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (PrefsJSON Nothing)
|
||||
emptyChatPrefs = Preferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (NoJSON Nothing)
|
||||
|
||||
defaultGroupPrefs :: FullGroupPreferences
|
||||
defaultGroupPrefs =
|
||||
@@ -584,7 +586,7 @@ defaultGroupPrefs =
|
||||
}
|
||||
|
||||
emptyGroupPrefs :: GroupPreferences
|
||||
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (PrefsJSON Nothing)
|
||||
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (NoJSON Nothing)
|
||||
|
||||
businessGroupPrefs :: Preferences -> GroupPreferences
|
||||
businessGroupPrefs Preferences {timedMessages, fullDelete, reactions, voice, files, sessions, commands} =
|
||||
@@ -620,7 +622,7 @@ defaultBusinessGroupPrefs =
|
||||
comments = Just $ CommentsGroupPreference FEOff Nothing,
|
||||
signMessages = Just $ SignMessagesGroupPreference FEOff,
|
||||
commands = Nothing,
|
||||
_json = PrefsJSON Nothing
|
||||
_json = NoJSON Nothing
|
||||
}
|
||||
|
||||
data TimedMessagesPreference = TimedMessagesPreference
|
||||
@@ -1133,7 +1135,7 @@ toGroupPreferences groupPreferences@FullGroupPreferences {commands = ListDef cmd
|
||||
comments = pref SGFComments,
|
||||
signMessages = pref SGFSignMessages,
|
||||
commands = Just cmds,
|
||||
_json = PrefsJSON Nothing
|
||||
_json = NoJSON Nothing
|
||||
}
|
||||
where
|
||||
pref :: SGroupFeature f -> Maybe (GroupFeaturePreference f)
|
||||
|
||||
Reference in New Issue
Block a user