dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-10-20 08:02:24 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into f/directory-search

Browse Source 
Co-authored-by: Claude <noreply@anthropic.com>

# Conflicts:
#	apps/simplex-directory-service/src/Directory/Events.hs
#	apps/simplex-directory-service/src/Directory/Service.hs
#	src/Simplex/Chat/Core.hs
#	src/Simplex/Chat/Library/Internal.hs
#	tests/Bots/DirectoryTests.hs
This commit is contained in:
spaced4ndy
2026-10-12 17:34:32 +00:00
parent e48168e6d8 eda94a505d
commit 0e06ded808
996 changed files with 48336 additions and 3431 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+3
View File
@@ -29,6 +29,7 @@ import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime, nominalDay)
import Simplex.Chat.Badges (badgeServerCredential, defaultFileSizeLimits)
import Simplex.Chat.Call (supportedCallVRange)
import Simplex.Chat.Controller
import Simplex.Chat.Library.Commands
import Simplex.Chat.Operators
@@ -68,6 +69,7 @@ defaultChatConfig =
tbqSize = 1024
},
chatVRange = supportedChatVRange,
callVRange = supportedCallVRange,
badgePublicKeys = M.mapKeys fromIntegral entitlementIssuerKeys,
badgeServiceAddress = Just $ either error id $ strDecode "https://smp5.simplex.im/a#ooSNWlEZTO2RPE0Ff5ZoybAs5zEhWLMlQrXesnhaZHM",
badgeCurrentTime = getCurrentTime,
@@ -123,6 +125,7 @@ defaultChatConfig =
cleanupManagerInterval = 30 * 60, -- 30 minutes
cleanupManagerStepDelay = 3 * 1000000, -- 3 seconds
ciExpirationInterval = 30 * 60 * 1000000, -- 30 minutes
callInvitationTTL = 180, -- 3 minutes, the apps stop ringing for older invitations
highlyAvailable = False,
deliveryWorkerDelay = 0,
deliveryBucketSize = 10000,
src/Simplex/Chat/Archive.hs
+4
View File
@@ -124,11 +124,15 @@ deleteStorage = do
fs <- lift storageFiles
liftIO $ closeDBStore `withStores` fs
remove `withDBs` fs
removeExported `withDBs` fs
removeBackup `withDBs` fs
mapM_ removeDir $ filesPath fs
mapM_ removeDir $ assetsPath fs
mapM_ removeDir =<< chatReadVar tempDirectory
where
remove f = whenM (doesFileExist f) $ removeFile f
removeExported f = remove $ f <> ".exported"
removeBackup f = remove $ f <> ".bak"
removeDir d = whenM (doesDirectoryExist d) $ removePathForcibly d
data StorageFiles = StorageFiles
src/Simplex/Chat/Badges.hs
+60 -20
View File
@@ -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,9 +309,17 @@ 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)
deriving (ToJSON, FromJSON) via (StrJSON "ProofPresHeader" ProofPresHeader)
instance ToJSON ProofPresHeader where
toJSON = toJSON . BBSPresHeader . strEncode
toEncoding = toEncoding . BBSPresHeader . strEncode
instance FromJSON ProofPresHeader where
parseJSON v = parseJSON v >>= \(BBSPresHeader ph) -> either fail pure $ strDecode ph
instance StrEncoding ProofPresHeader where
strEncode = \case
@@ -305,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
@@ -316,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
@@ -419,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
@@ -453,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)
src/Simplex/Chat/Call.hs
+57 -3
View File
@@ -1,11 +1,13 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
@@ -21,6 +23,7 @@ import Data.ByteString.Char8 (ByteString)
import Data.Int (Int64)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Word (Word16)
import Simplex.Chat.Options.DB (FromField (..), ToField (..))
import Simplex.Chat.Types (Contact, ContactId, User)
import Simplex.Messaging.Agent.Store.DB (Binary (..), fromTextField_)
@@ -28,6 +31,8 @@ import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, singleFieldJSON)
import Simplex.Messaging.Util (decodeJSON, encodeJSON)
import Simplex.Messaging.Version
import Simplex.Messaging.Version.Internal
data Call = Call
{ contactId :: ContactId,
@@ -39,6 +44,52 @@ data Call = Call
}
deriving (Show)
-- Call version history:
-- 1 - DH secret is used as media key (also assumed when call messages have no version)
-- 2 - media key is derived from DH secret with HKDF (2026-10-01)
data CallVersion
instance VersionScope CallVersion
type VersionCall = Version CallVersion
type VersionRangeCall = VersionRange CallVersion
pattern VersionCall :: Word16 -> VersionCall
pattern VersionCall v = Version v
initialCallVersion :: VersionCall
initialCallVersion = VersionCall 1
callMediaKdfVersion :: VersionCall
callMediaKdfVersion = VersionCall 2
-- This should not be used directly in code, instead use `callVRange` from ChatConfig
currentCallVersion :: VersionCall
currentCallVersion = VersionCall 2
supportedCallVRange :: VersionRangeCall
supportedCallVRange = mkVersionRange initialCallVersion currentCallVersion
callInitialVRange :: VersionRangeCall
callInitialVRange = versionToRange initialCallVersion
newtype CallVersionRange = CallVersionRange {fromCallVRange :: VersionRangeCall}
deriving (Eq, Show)
deriving (FromJSON, ToJSON) via (StrJSON "CallVersionRange" VersionRangeCall)
callMediaKey :: VersionCall -> CallId -> C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.Key
callMediaKey v (CallId salt) peerPubKey privKey
| v >= callMediaKdfVersion = C.Key $ C.hkdf salt dhSecret "SimpleXCallMediaKey" callMediaKeySize
| otherwise = C.Key dhSecret
where
dhSecret = C.dhBytes' $ C.dh' peerPubKey privKey
-- AES-256-GCM key used by the apps for frame encryption
callMediaKeySize :: Int
callMediaKeySize = 32
isRcvInvitation :: Call -> Bool
isRcvInvitation Call {callState} = case callState of
CallInvitationReceived {} -> True
@@ -68,7 +119,8 @@ data CallState
| CallInvitationReceived
{ peerCallType :: CallType,
localDhPubKey :: Maybe C.PublicKeyX25519,
sharedKey :: Maybe C.Key
sharedKey :: Maybe C.Key,
callVersion :: Maybe VersionCall
}
| CallOfferSent
{ localCallType :: CallType,
@@ -134,7 +186,8 @@ encryptedCall CallType {capabilities = CallCapabilities {encryption}} = encrypti
-- | * Types for chat protocol
data CallInvitation = CallInvitation
{ callType :: CallType,
callDhPubKey :: Maybe C.PublicKeyX25519
callDhPubKey :: Maybe C.PublicKeyX25519,
callVRange :: Maybe CallVersionRange
}
deriving (Eq, Show)
@@ -149,7 +202,8 @@ data CallCapabilities = CallCapabilities
data CallOffer = CallOffer
{ callType :: CallType,
rtcSession :: WebRTCSession,
callDhPubKey :: Maybe C.PublicKeyX25519
callDhPubKey :: Maybe C.PublicKeyX25519,
callVersion :: Maybe VersionCall
}
deriving (Eq, Show)
src/Simplex/Chat/Controller.hs
+6 -1
View File
@@ -144,6 +144,7 @@ coreVersionInfo simplexmqCommit =
data ChatConfig = ChatConfig
{ agentConfig :: AgentConfig,
chatVRange :: VersionRangeChat,
callVRange :: VersionRangeCall,
-- issuer public keys by index: credentials and proofs name the key that signed them, for rotation
badgePublicKeys :: Map Int BBSPublicKey,
-- Nothing until the badge service is deployed
@@ -174,6 +175,7 @@ data ChatConfig = ChatConfig
cleanupManagerInterval :: NominalDiffTime,
cleanupManagerStepDelay :: Int64,
ciExpirationInterval :: Int64, -- microseconds
callInvitationTTL :: NominalDiffTime,
deliveryWorkerDelay :: Int64, -- microseconds
deliveryBucketSize :: Int,
webPreviewConfig :: Maybe WebPreviewConfig,
@@ -447,7 +449,7 @@ data ChatCommand
| APIGetCallInvitations
| APICallStatus ContactId WebRTCCallStatus
| APIUpdateProfile {userId :: UserId, profile :: Profile}
| APISetUserDomain {userId :: UserId, simplexDomain :: Maybe SimplexDomain}
| APISetUserDomain {userId :: UserId, simplexDomain :: Maybe (StrJSON "SimplexDomain" SimplexDomain)}
| APISetContactPrefs {contactId :: ContactId, preferences :: Preferences}
| APISetContactAlias {contactId :: ContactId, localAlias :: LocalAlias}
| APISetGroupAlias {groupId :: GroupId, localAlias :: LocalAlias}
@@ -464,6 +466,7 @@ data ChatCommand
| APIGetNtfConns {nonce :: C.CbNonce, encNtfInfo :: ByteString}
| APIGetConnNtfMessages (NonEmpty ConnMsgReq)
| APIAddMember {groupId :: GroupId, contactId :: ContactId, memberRole :: GroupMemberRole}
| APIAddMemberViaGroup {groupId :: GroupId, viaGroupId :: GroupId, groupMemberId :: GroupMemberId, memberRole :: GroupMemberRole}
| APIJoinGroup {groupId :: GroupId, enableNtfs :: MsgFilter}
| APIAcceptMember {groupId :: GroupId, groupMemberId :: GroupMemberId, memberRole :: GroupMemberRole}
| APIDeleteMemberSupportChat GroupId GroupMemberId
@@ -876,6 +879,7 @@ data ChatResponse
| CRUserDeletedMembers {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], withMessages :: Bool, msgSigned :: Bool}
| CRGroupsList {user :: User, groups :: [GroupInfo]}
| CRSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
| CRSentGroupInvitationViaGroup {user :: User, groupInfo :: GroupInfo, member :: GroupMember, viaGroupInfo :: GroupInfo, viaMember :: GroupMember}
| CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
| CRFileTransferStatusXFTP User AChatItem
| CRUserProfile {user :: User, profile :: Profile}
@@ -1027,6 +1031,7 @@ data ChatEvent
| CEvtHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CEvtHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CEvtReceivedGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, fromMemberRole :: GroupMemberRole, memberRole :: GroupMemberRole}
| CEvtReceivedGroupInvitationViaGroup {user :: User, groupInfo :: GroupInfo, viaGroupInfo :: GroupInfo, viaMember :: GroupMember, fromMemberRole :: GroupMemberRole, memberRole :: GroupMemberRole}
| CEvtUserJoinedGroup {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
| CEvtGroupLinkDataUpdated {user :: User, groupInfo :: GroupInfo, groupLink :: GroupLink, groupRelays :: [GroupRelay], relaysChanged :: Bool}
| CEvtGroupRelayUpdated {user :: User, groupInfo :: GroupInfo, member :: GroupMember, groupRelay :: GroupRelay}
src/Simplex/Chat/Core.hs
+22 -9
View File
@@ -13,12 +13,15 @@ module Simplex.Chat.Core
)
where
import Control.Concurrent (forkIO)
import Control.Exception (fromException, mask, onException, throwTo)
import Control.Logger.Simple
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as B
import Data.List (find)
import Data.Maybe (isNothing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
@@ -72,10 +75,10 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@Cha
noMaintenance
img_ <- mapM loadImageFile userImageFile
createActiveUser cc coreOptions createBot userDisplayName img_
Just u@User {localDisplayName} -> do
Just u@User {profile = LocalProfile {displayName}} -> do
forM_ userDisplayName $ \name ->
when (localDisplayName /= name) $ do
putStrLn $ "Active user display name " <> show localDisplayName <> " does not match --user-display-name " <> show name
when (displayName /= name) $ do
putStrLn $ "Active user display name " <> show displayName <> " does not match --user-display-name " <> show name
exitFailure
-- --user-image-file only applies when the profile is created; ignore it for an existing user
forM_ userImageFile $ \_ ->
@@ -90,12 +93,22 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@Cha
runSimplexChat :: ChatConfig -> ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
runSimplexChat ChatConfig {testView} ChatOpts {coreOptions = CoreChatOpts {chatRelay, chatRelayServer, headless, serviceRequests, maintenance}} u cc@ChatController {config = ChatConfig {chatHooks}} chat
| maintenance = wait =<< async (chat u cc)
| otherwise = flip finally (stopChatController cc) $ do
a1 <- runReaderT (startChatController True True serviceRequests) cc
when (chatRelay && not testView) $ askCreateRelayAddress cc u chatRelayServer headless
forM_ (postStartHook chatHooks) ($ cc)
a2 <- async $ chat u cc
waitEither_ a1 a2
| otherwise = do
a1 <- runReaderT (startChatController True True serviceRequests) cc `onException` stopChatController cc
flip finally (stopUnlessCancelled a1) $ do
when (chatRelay && not testView) $ askCreateRelayAddress cc u chatRelayServer headless
forM_ (postStartHook chatHooks) ($ cc)
-- throwTo waits while the callback is masked, so an outside interrupt cancels it from a forked thread.
-- A /_stop sent from the callback ends a1 first, which leaves the callback running.
mask $ \restore -> do
a2 <- asyncWithUnmask $ \unmask -> unmask (chat u cc)
let cancelCallback = poll a1 >>= \r -> when (isNothing r) $ void $ forkIO $ throwTo (asyncThreadId a2) AsyncCancelled
restore (waitEither_ a1 a2) `onException` cancelCallback
where
stopUnlessCancelled a1 =
poll a1 >>= \case
Just (Left e) | fromException e == Just AsyncCancelled -> pure ()
_ -> stopChatController cc
sendChatCmdStr :: ChatController -> String -> IO (Either ChatError ChatResponse)
sendChatCmdStr cc s = runReaderT (execChatCommand CSLocal (encodeUtf8 $ T.pack s) 0) cc
src/Simplex/Chat/Library/Commands.hs
+204 -107
View File
@@ -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)
@@ -174,7 +174,9 @@ checkProfileImageSize = mapM_ $ \(ImageData t) ->
in when (size > maxProfileImageSize) $ throwCmdError $ "Profile image is too large " <> show size
checkProfileSize :: Profile -> CM ()
checkProfileSize p = checkInfoSize "Profile" (XInfo p Nothing)
checkProfileSize p@Profile {contactDomain} = checkInfoSize "Profile" (XInfo p' Nothing)
where
p' = (p :: Profile) {badge = Nothing, contactDomain = (\d -> d {proof = Nothing} :: SimplexDomainClaim) <$> contactDomain}
checkGroupProfileSize :: GroupProfile -> CM ()
checkGroupProfileSize p = checkInfoSize "Group profile" (XGrpInfo p)
@@ -351,7 +353,9 @@ startReceiveUserFiles user = do
restoreCalls :: CM' ()
restoreCalls = do
savedCalls <- fromRight [] <$> runExceptT (withFastStore' getCalls)
ttl <- asks (callInvitationTTL . config)
cutoffTs <- addUTCTime (-ttl) <$> liftIO getCurrentTime
savedCalls <- fromRight [] <$> runExceptT (withFastStore' $ \db -> expireCalls db cutoffTs >> getCalls db)
let callsMap = M.fromList $ map (\call@Call {contactId} -> (contactId, call)) savedCalls
calls <- asks currentCalls
atomically $ writeTVar calls callsMap
@@ -452,7 +456,7 @@ processChatCommand cxt nm = \case
p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile
u <- asks currentUser
users <- withFastStore' getUsers
forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash, userChatRelay = userChatRelay'} -> do
forM_ users $ \User {profile = LocalProfile {displayName = n}, activeUser, viewPwdHash, userChatRelay = userChatRelay'} -> do
when (n == displayName) . throwChatError $
if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""}
when (isTrue userChatRelay && isTrue userChatRelay') $ throwChatError CEChatRelayExists
@@ -1515,7 +1519,8 @@ processChatCommand cxt nm = \case
callId <- atomically $ CallId <$> C.randomBytes 16 g
callUUID <- UUID.toText <$> liftIO V4.nextRandom
dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing
let invitation = CallInvitation {callType, callDhPubKey = fst <$> dhKeyPair}
ChatConfig {callVRange = callVR} <- asks config
let invitation = CallInvitation {callType, callDhPubKey = fst <$> dhKeyPair, callVRange = Just $ CallVersionRange callVR}
callState = CallInvitationSent {localCallType = callType, localDhPrivKey = snd <$> dhKeyPair}
(msg, _) <- sendDirectContactMessage user ct (XCallInv callId invitation)
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndCall CISCallPending 0)
@@ -1543,9 +1548,9 @@ processChatCommand cxt nm = \case
APISendCallOffer contactId WebRTCCallOffer {callType, rtcSession} ->
-- party accepting call
withCurrentCall contactId $ \user ct call@Call {callId, chatItemId, callState} -> case callState of
CallInvitationReceived {peerCallType, localDhPubKey, sharedKey} -> do
CallInvitationReceived {peerCallType, localDhPubKey, sharedKey, callVersion} -> do
let callDhPubKey = if encryptedCall callType then localDhPubKey else Nothing
offer = CallOffer {callType, rtcSession, callDhPubKey}
offer = CallOffer {callType, rtcSession, callDhPubKey, callVersion}
callState' = CallOfferSent {localCallType = callType, peerCallType, localCallSession = rtcSession, sharedKey}
aciContent = ACIContent SMDRcv $ CIRcvCall CISCallAccepted 0
(SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XCallOffer callId offer)
@@ -1599,8 +1604,9 @@ processChatCommand cxt nm = \case
APICallStatus contactId receivedStatus ->
withCurrentCall contactId $ \user ct call ->
updateCallItemStatus user ct call receivedStatus Nothing $> Just call
APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile)
APISetUserDomain userId domain_ -> withUserId userId $ \user@User {profile = p@LocalProfile {contactLink, contactDomain}} ->
APIUpdateProfile userId profile -> withUserProfileLock "updateProfile" $ withUserId userId (`updateProfile` profile)
APISetUserDomain userId strDomain_ -> withUserProfileLock "setUserDomain" $ withUserId userId $ \user@User {profile = p@LocalProfile {contactLink, contactDomain}} -> do
let domain_ = unStrJSON <$> strDomain_
if (claimDomain <$> contactDomain) == domain_
then pure $ CRUserProfileNoChange user
else do
@@ -1639,7 +1645,7 @@ processChatCommand cxt nm = \case
APISetUserUIThemes uId uiThemes -> withUser $ \user@User {userId} -> do
user'@User {userId = uId'} <- withFastStore $ \db -> do
user' <- getUser db uId
liftIO $ setUserUIThemes db user uiThemes
liftIO $ setUserUIThemes db user' uiThemes
pure user'
when (userId == uId') $ chatWriteVar currentUser $ Just (user :: User) {uiThemes}
ok user'
@@ -2124,11 +2130,11 @@ 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
(preparedReq, preparedParams@PreparedLinkParams {plpLinkKey = LinkKey linkKey}) <- withAgent $ \a -> prepareInvitationLink a (aUserId user) IKUsePQ 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 -> createInvitationForLink a nm (aUserId user) True preparedReq 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 +2143,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 +2153,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 +2172,13 @@ 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
(preparedReq, preparedParams@PreparedLinkParams {plpLinkKey = LinkKey linkKey}) <- withAgent $ \a -> prepareInvitationLink a (aUserId newUser) IKPQOn Nothing
userLinkData <- UserInvLinkData . (`contactShortLinkData` Nothing) <$> presentUserBadge newUser Nothing (Just $ PHLink linkKey) (userProfileDirect newUser Nothing Nothing True)
withAgent $ \a -> createInvitationForLink a nm (aUserId newUser) True preparedReq 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 +2213,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
@@ -2474,7 +2482,7 @@ processChatCommand cxt nm = \case
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
let ccLink'' = if isTrue userChatRelay then setShortLinkType CCTRelay ccLink' else ccLink'
@@ -2482,12 +2490,12 @@ processChatCommand cxt nm = \case
pure $ CRUserContactLinkCreated user ccLink''
CreateMyAddress ratchetKeys_ -> withUser $ \User {userId} ->
processChatCommand cxt nm $ APICreateMyAddress userId Nothing ratchetKeys_
APIDeleteMyAddress userId -> withUserId userId $ \user@User {profile = p} -> do
APIDeleteMyAddress userId -> withUserProfileLock "deleteMyAddress" $ withUserId userId $ \user@User {profile = p} -> do
conn <- withFastStore $ \db -> getUserAddressConnection db cxt user
withChatLock "deleteMyAddress" $ do
deleteAgentConnectionAsync $ aConnId conn
withFastStore' (`deleteUserAddress` user)
let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing}
let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing, contactDomain = Nothing}
r <- updateProfile_ user p' False $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing
let user' = case r of
CRUserProfileUpdated u' _ _ _ -> u'
@@ -2505,10 +2513,10 @@ processChatCommand cxt nm = \case
CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData False pqInitKeys user)
APIRotateAddressRatchetKeys userId -> withUserId' userId $ \user ->
CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData True (Just IKUsePQ) user)
APISetProfileAddress userId False -> withUserId userId $ \user@User {profile = p} -> do
let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing}
APISetProfileAddress userId False -> withUserProfileLock "setProfileAddress" $ withUserId userId $ \user@User {profile = p} -> do
let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing, contactDomain = Nothing}
updateProfile_ user p' True $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing
APISetProfileAddress userId True -> withUserId userId $ \user@User {profile = p} -> do
APISetProfileAddress userId True -> withUserProfileLock "setProfileAddress" $ withUserId userId $ \user@User {profile = p} -> do
ucl <- withFastStore (`getUserAddress` user)
-- TODO [short links] replace with short links
let p' = (fromLocalProfile p :: Profile) {contactLink = Just $ profileContactLink ucl}
@@ -2765,7 +2773,7 @@ processChatCommand cxt nm = \case
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 +2785,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 +2798,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
@@ -2837,18 +2845,53 @@ processChatCommand cxt nm = \case
pure $ CRSentGroupInvitation user gInfo contact member {memberRole = memRole}
Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName
| otherwise -> throwChatError $ CEGroupDuplicateMember cName
APIAddMemberViaGroup groupId viaGroupId gmId memRole -> withUser $ \user -> withGroupLock "addMember" groupId $ do
(g@(GIK gInfo _), viaGInfo, m) <- withFastStore $ \db ->
(,,) <$> getGroupInfoKeys db cxt user groupId <*> getGroupInfo db cxt user viaGroupId <*> getGroupMember db cxt user viaGroupId gmId
let GroupMember {localDisplayName = mName} = m
when (viaGroupId == groupId) $ throwChatError $ CEGroupDuplicateMember mName
when (useRelays' gInfo) $ throwCmdError "can't invite member to channel"
when (useRelays' viaGInfo) $ throwCmdError "can't invite member from channel"
assertUserGroupRole gInfo $ max GRAdmin memRole
assertUserGroupRole viaGInfo GRAuthor
unless (groupFeatureUserAllowed SGFDirectMessages viaGInfo) $ throwCmdError "direct messages not allowed"
when (incognitoMembership viaGInfo) $ throwChatError CEContactIncognitoCantInvite
when (incognitoMembership gInfo) $ throwChatError CEGroupIncognitoCantInvite
mConn <- case memberConn m of
Just conn | memberCurrent m -> pure conn
_ -> throwChatError CEGroupMemberNotActive
unless (m `supportsVersion` groupInvVersion) $ throwChatError CEPeerChatVRangeIncompatible
let sendInvitation = sendGrpInvitationViaGroup user viaGInfo m mConn g
withFastStore' (\db -> getMemberInvitedVia db cxt user gInfo m) >>= \case
Nothing -> do
gVar <- asks random
subMode <- chatReadVar subscriptionMode
(agentConnId, CCLink cReq _) <- withAgent $ \a -> createConnection a nm (aUserId user) True False SCMInvitation Nothing Nothing IKPQOff True subMode
member <- withFastStore $ \db -> createNewMemberViaGroup db gVar cxt user gInfo m mConn memRole agentConnId cReq subMode
sendInvitation member cReq
pure $ CRSentGroupInvitationViaGroup user gInfo member viaGInfo m
Just member@GroupMember {groupMemberId, memberStatus, memberRole = mRole}
| memberStatus == GSMemInvited -> do
unless (mRole == memRole) $ withFastStore' $ \db -> updateGroupMemberRole db user member memRole
withFastStore' (\db -> getMemberInvitation db user groupMemberId) >>= \case
Just cReq -> do
sendInvitation member {memberRole = memRole} cReq
pure $ CRSentGroupInvitationViaGroup user gInfo member {memberRole = memRole} viaGInfo m
Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo mName
| otherwise -> throwChatError $ CEGroupDuplicateMember mName
APIJoinGroup groupId enableNtfs -> withUser $ \user@User {userId} -> do
withGroupLock "joinGroup" groupId $ do
(invitation, ct) <- withFastStore $ \db -> do
(invitation, ct_) <- withFastStore $ \db -> do
inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db cxt user groupId
(inv,) <$> getContactViaMember db cxt user fromMember
(inv,) <$> forM (memberContactId fromMember) (\_ -> 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
peerChatVRange_ = case ct_ of
Nothing -> Right $ memberChatVRange' fromMember
Just ct@Contact {activeConn} -> maybe (Left ct) (\Connection {peerChatVRange} -> Right peerChatVRange) activeConn
case peerChatVRange_ of
Right 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
@@ -2867,12 +2910,15 @@ processChatCommand cxt nm = \case
updateGroupMemberStatus db userId fromMember GSMemInvited
updateGroupMemberStatus db userId membership GSMemInvited
throwError e
updateCIGroupInvitationStatus user g CIGISAccepted `catchAllErrors` eToView
updateCIGroupInvitationStatus user g CIGISAccepted `catchAllErrors` \case
ChatErrorStore SEChatItemNotFoundByGroupId {} -> pure ()
e -> eToView e
pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing
Nothing -> throwChatError $ CEContactNotActive ct
Left ct -> throwChatError $ CEContactNotActive ct
APIAcceptMember groupId gmId role -> withUser $ \user@User {userId} -> do
(g@(GIK gInfo _), m) <- withFastStore $ \db -> (,) <$> getGroupInfoKeys db cxt user groupId <*> getGroupMemberById db cxt user gmId
assertUserGroupRole gInfo $ max GRModerator role
-- same rule as role change (moderators grant up to member); pending member's role is a stand-in, so treat it as member
assertUserGroupRole gInfo $ roleRequiredToChange GRMember role
case memberStatus m of
GSMemPendingApproval | memberCategory m == GCInviteeMember -> do -- only host can approve
let GroupInfo {groupProfile = GroupProfile {memberAdmission}} = gInfo
@@ -2951,6 +2997,8 @@ processChatCommand cxt nm = \case
throwCmdError "can't change role of multiple members when admins selected, or new role is admin"
when anyPending $ throwCmdError "can't change role of members pending approval"
when (anyRelay || newRole == GRRelay) $ throwCmdError "relay role can't be changed"
-- TODO [multi-owner] allow once owners are added via link data - until then promoted owner would lack link authority
when (useRelays' gInfo && newRole == GROwner) $ throwCmdError "owner role can't be assigned in channels"
-- TODO allow moderators (needs UI) - relay is rejected above (anyRelay), so drop the GRAdmin floor:
-- TODO assertUserGroupRole gInfo (roleRequiredToChange maxRole newRole)
assertUserGroupRole gInfo $ maximum ([GRAdmin, maxRole, newRole] :: [GroupMemberRole])
@@ -3398,21 +3446,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
@@ -3581,23 +3629,23 @@ processChatCommand cxt nm = \case
-- after the write, so the pass it signals arms a wake for the snooze rather than raising again
lift $ startBadgeWork user
CRBadgeState user <$> getUserBadgeState user
SetBotCommands commands -> withUser $ \user@User {profile} -> do
SetBotCommands commands -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
let LocalProfile {preferences} = profile
prefs = Just (fromMaybe emptyChatPrefs preferences :: Preferences) {commands = Just commands}
p = (fromLocalProfile profile :: Profile) {preferences = prefs, peerType = Just CPTBot}
updateProfile user p
UpdateProfile displayName shortDescr -> withUser $ \user@User {profile} -> do
UpdateProfile displayName shortDescr -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
let p = (fromLocalProfile profile :: Profile) {displayName, shortDescr, fullName = ""}
updateProfile user p
UpdateProfileImage image -> withUser $ \user@User {profile} -> do
UpdateProfileImage image -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
let p = (fromLocalProfile profile :: Profile) {image}
updateProfile user p
UpdateProfileImageFromFile path -> withUser $ \user@User {profile} -> do
UpdateProfileImageFromFile path -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
img <- readProfileImageFile path
let p = (fromLocalProfile profile :: Profile) {image = Just img}
updateProfile user p
ShowProfileImage -> withUser $ \user@User {profile} -> pure $ CRUserProfileImage user $ fromLocalProfile profile
SetUserFeature (ACF f) allowed -> withUser $ \user@User {profile} -> do
SetUserFeature (ACF f) allowed -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
let p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference f (Just allowed) $ preferences' user}
updateProfile user p
SetContactFeature (ACF f) cName allowed_ -> withUser $ \user -> do
@@ -3615,7 +3663,7 @@ processChatCommand cxt nm = \case
case memberAdmission of
Nothing -> p {memberAdmission = Just (emptyGroupMemberAdmission :: GroupMemberAdmission) {review = reviewAdmissionApplication}}
Just ma -> p {memberAdmission = Just (ma :: GroupMemberAdmission) {review = reviewAdmissionApplication}}
SetUserTimedMessages onOff -> withUser $ \user@User {profile} -> do
SetUserTimedMessages onOff -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
let allowed = if onOff then FAYes else FANo
pref = TimedMessagesPreference allowed Nothing
p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference' SCFTimedMessages (Just pref) $ preferences' user}
@@ -3684,6 +3732,7 @@ processChatCommand cxt nm = \case
CLContactRequest crId -> "ContactRequest " <> tshow crId
CLFile fId -> "File " <> tshow fId
CLBadgeUser uId -> "BadgeUser " <> tshow uId
CLUserProfile -> "UserProfile"
DebugEvent event -> toView event >> ok_
GetAgentSubsTotal userId -> withUserId userId $ \user -> do
users <- withStore' $ \db -> getUsers db
@@ -3817,7 +3866,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
@@ -3825,12 +3874,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
@@ -3884,14 +3933,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
@@ -3900,8 +3949,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) =
@@ -3909,23 +3958,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"
@@ -3966,27 +4015,27 @@ 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
Just (Just gInfo@(GIK g gks))
| useRelays' g -> case relayMemberId_ of
Just relayMemberId -> encodeXMemberConnInfo gInfo relayMemberId profileToSend
Just relayMemberId -> encodeXMemberConnInfo pqSup gInfo relayMemberId profileToSend
Nothing -> throwChatError $ CEInternalError "relay group join without target relay memberId"
| otherwise -> encodeConnInfoPQ pqSup $ XContact profileToSend (Just $ groupMemberKey gks) (Just xContactId) welcomeSharedMsgId msg_
_ ->
@@ -3994,6 +4043,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} ->
@@ -4008,20 +4061,29 @@ processChatCommand cxt nm = \case
when (fileSize > maxSndXFTPFileSize lims now sndBadge) $ throwChatError $ CEFileSize f
pure fileSize
updateProfile :: User -> Profile -> CM ChatResponse
updateProfile user p' = updateProfile_ user p' True $ withFastStore $ \db -> updateUserProfile db user p'
updateProfile user@User {profile = LocalProfile {contactDomain}} p = updateProfile_ user p' True $ withFastStore $ \db -> updateUserProfile db user p'
where
p' = (p :: Profile) {contactDomain}
updateProfile_ :: User -> Profile -> Bool -> CM User -> CM ChatResponse
updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n', image = img'} shouldUpdateAddressData updateUser
| p' == fromLocalProfile p = pure $ CRUserProfileNoChange user
| otherwise = do
when (n /= n') $ checkValidName n'
when (n /= n') $ do
checkValidName n'
users <- withFastStore' getUsers
forM_ users $ \User {profile = LocalProfile {displayName}, activeUser, viewPwdHash} ->
when (displayName == n') . throwChatError $
if activeUser || isNothing viewPwdHash then CEUserExists n' else CEInvalidDisplayName {displayName = n', validName = ""}
checkProfileImageSize img'
checkProfileSize p'
when shouldUpdateAddressData $ do
ts <- liftIO getCurrentTime
setMyAddressData' (user :: User) {profile = updatedUserProfile user p' ts}
-- read contacts before user update to correctly merge preferences
contacts <- withFastStore' $ \db -> getUserContacts db cxt user
user' <- updateUser
asks currentUser >>= atomically . (`writeTVar` Just user')
withChatLock "updateProfile" $ do
when shouldUpdateAddressData $ setMyAddressData' user'
summary <- sendUpdateToContacts user' contacts
pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' summary
where
@@ -4039,7 +4101,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
@@ -4064,18 +4127,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
@@ -4089,7 +4153,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_
@@ -4099,7 +4163,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'
@@ -4298,8 +4362,27 @@ 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 =
sendGrpInvitationViaGroup :: User -> GroupInfo -> GroupMember -> Connection -> GroupInfoKeys -> GroupMember -> ConnReqInvitation -> CM ()
sendGrpInvitationViaGroup user viaGInfo GroupMember {localDisplayName} mConn (GIK gInfo@GroupInfo {groupId, groupProfile, membership, businessChat} gks) GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do
let currentMemCount = fromIntegral $ currentMembers $ groupSummary gInfo
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
groupInv =
GroupInvitation
{ fromMember = MemberIdRole userMemberId userRole,
fromMemberKey = Just $ groupMemberKey gks,
invitedMember = MemberIdRole memberId memRole,
connRequest = cReq,
groupProfile,
business = businessChat,
groupLinkId = Nothing,
groupSize = Just currentMemCount
}
(msg, _, _) <- sendDirectMemberMessage mConn (XGrpInv groupInv) (groupId' viaGInfo)
let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
ci <- saveSndChatItem user (CDGroupSnd viaGInfo Nothing) msg content
toView $ CEvtNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat viaGInfo Nothing) ci]
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)
@@ -4319,14 +4402,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
@@ -4404,7 +4490,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
@@ -4458,12 +4544,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
@@ -4749,7 +4836,7 @@ processChatCommand cxt nm = \case
shortenShortLink' =<< withAgent (\a -> setConnShortLink a nm (aConnId' conn) SCMInvitation userLinkData Nothing False Nothing)
updateCIGroupInvitationStatus :: User -> GroupInfo -> CIGroupInvitationStatus -> CM ()
updateCIGroupInvitationStatus user GroupInfo {groupId} newStatus = do
AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withFastStore $ \db -> getChatItemByGroupId db cxt user groupId
AChatItem _ _ cInfo ci@ChatItem {content, meta = meta@CIMeta {itemId}} <- withFastStore $ \db -> getChatItemByGroupId db cxt user groupId
case (cInfo, content) of
(DirectChat ct@Contact {contactId}, CIRcvGroupInvitation ciGroupInv@CIGroupInvitation {status} memRole)
| status == CIGISPending -> do
@@ -4758,6 +4845,14 @@ processChatCommand cxt nm = \case
updateDirectChatItemView user ct itemId aciContent False False timed_ Nothing
forM_ (timed_ >>= timedDeleteAt') $
startProximateTimedItemThread user (ChatRef CTDirect contactId Nothing, itemId)
(GroupChat g _, CIRcvGroupInvitation ciGroupInv@CIGroupInvitation {status} memRole)
| status == CIGISPending -> do
let content' = CIRcvGroupInvitation (ciGroupInv {status = newStatus} :: CIGroupInvitation) memRole
timed_ <- sndGroupCITimed False g Nothing
ci' <- withFastStore' $ \db -> updateGroupChatItem db user (groupId' g) ci {meta = meta {itemTimed = timed_}} content' False False Nothing
toView $ CEvtChatItemUpdated user (AChatItem SCTGroup SMDRcv cInfo ci')
forM_ (timed_ >>= timedDeleteAt') $
startProximateTimedItemThread user (ChatRef CTGroup (groupId' g) Nothing, itemId)
_ -> pure () -- prohibited
assertAllowedContent :: MsgContent -> CM ()
assertAllowedContent = \case
@@ -5210,14 +5305,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.
@@ -5629,7 +5722,7 @@ presentIssuedBadge user p@UserBadgePurchase {badgePurchaseId, shown} now
| otherwise = do
cred_ <- withStore' (`getLatestIssuedCredential` badgePurchaseId)
forM_ cred_ $ \cred@(BadgeCredential _ _ _ info) ->
when (presentDue cred) $ do
when (presentDue cred) $ withUserProfileLock "presentIssuedBadge" $ do
user' <- withStore $ \db -> setUserBadge db user (Just $ OwnBadge cred (mkBadgeStatus now (Just True) info))
presentUserBadgeToContacts user'
where
@@ -5642,7 +5735,7 @@ presentIssuedBadge user p@UserBadgePurchase {badgePurchaseId, shown} now
retireExpiredBadge :: User -> UserBadgePurchase -> UTCTime -> StatementEntry -> CM Bool
retireExpiredBadge user UserBadgePurchase {badgePurchaseId, shown} now balance
| not (shown && L.paidThrough balance <= now) = pure False
| otherwise = do
| otherwise = withUserProfileLock "retireExpiredBadge" $ do
user' <- withStore $ \db -> do
liftIO $ clearShownBadge db user badgePurchaseId
setUserBadge db user Nothing
@@ -6131,7 +6224,7 @@ chatCommandP =
"/_call status @" *> (APICallStatus <$> A.decimal <* A.space <*> strP),
"/_call get" $> APIGetCallInvitations,
"/_profile " *> (APIUpdateProfile <$> A.decimal <* A.space <*> jsonP),
"/_set domain " *> (APISetUserDomain <$> A.decimal <*> optional (A.space *> strP)),
"/_set domain " *> (APISetUserDomain <$> A.decimal <*> optional (A.space *> (StrJSON <$> strP))),
"/_set alias @" *> (APISetContactAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
"/_set alias #" *> (APISetGroupAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
"/_set alias :" *> (APISetConnectionAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
@@ -6148,6 +6241,7 @@ chatCommandP =
"/_ntf conns " *> (APIGetNtfConns <$> strP <* A.space <*> strP),
"/_ntf conn messages " *> (APIGetConnNtfMessages <$> connMsgsP),
"/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
"/_add #" *> (APIAddMemberViaGroup <$> A.decimal <* " #" <*> A.decimal <* A.space <*> A.decimal <*> memberRole),
"/_join #" *> (APIJoinGroup <$> A.decimal <*> pure MFAll), -- needs to be changed to support in UI
"/_accept member #" *> (APIAcceptMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
"/_delete member chat #" *> (APIDeleteMemberSupportChat <$> A.decimal <* A.space <*> A.decimal),
@@ -6679,8 +6773,11 @@ displayNameP_ = quoted '\'' <|> takeNameTill (\c -> isSpace c || c == ',')
refChar c = c > ' ' && c /= '#' && c /= '@' && c /= '\''
mkValidName :: String -> String
mkValidName = dropWhileEnd isSpace . take 50 . reverse . fst3 . foldl' addChar ("", '\NUL', 0 :: Int)
mkValidName = noLdnSuffix . dropWhileEnd isSpace . take 50 . reverse . fst3 . foldl' addChar ("", '\NUL', 0 :: Int)
where
noLdnSuffix s = case break (== '_') (reverse s) of
(ds@(_ : _), '_' : rest@(_ : _)) | all isDigit ds -> reverse rest <> ('-' : reverse ds)
_ -> s
fst3 (x, _, _) = x
addChar (r, prev, punct) c' = if validChar then (c : r, c, punct') else (r, prev, punct)
where
src/Simplex/Chat/Library/Internal.hs
+150 -81
View File
@@ -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
@@ -160,6 +160,10 @@ withFileLock :: Text -> Int64 -> CM a -> CM a
withFileLock name = withEntityLock name . CLFile
{-# INLINE withFileLock #-}
withUserProfileLock :: Text -> CM a -> CM a
withUserProfileLock name = withEntityLock name CLUserProfile
{-# INLINE withUserProfileLock #-}
useServerCfgs :: forall p. UserProtocol p => SProtocolType p -> RandomAgentServers -> [(Text, ServerOperator)] -> [UserServer p] -> NonEmpty (ServerCfg p)
useServerCfgs p RandomAgentServers {smpServers, xftpServers} opDomains =
fromMaybe (rndAgentServers p) . L.nonEmpty . agentServerCfgs p opDomains
@@ -443,10 +447,11 @@ xftpSndFileTransfer_ user file@(CryptoFile filePath cfArgs) fileSize n contactOr
fInv = (xftpFileInvitation fileName fileSize dummyFileDescr :: FileInvitation) {fileBadge}
fsFilePath <- lift $ toFSFilePath filePath
let srcFile = CryptoFile fsFilePath cfArgs
aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) srcFile (roundedFDCount n) Nothing
aFileId <- withAgent $ \a -> xftpPrepareSendFile a (aUserId user) srcFile (roundedFDCount n) Nothing
-- TODO CRSndFileStart event for XFTP
chSize <- asks $ fileChunkSize . config
ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup_ file fInv (AgentSndFileId aFileId) Nothing chSize
withAgent (`xftpStartSendFile` aFileId)
let fileSource = Just $ CryptoFile filePath cfArgs
ciFile = CIFile {fileId, fileName, fileSize, fileSource, fileStatus = CIFSSndStored, fileProtocol = FPXFTP, fileExpires = Nothing, fileProhibited = Nothing}
pure (fInv, ciFile, ft)
@@ -485,9 +490,10 @@ xftpSndFileRedirect user ftId vfd = do
let fileName = "redirect.yaml"
file = CryptoFile fileName Nothing
fInv = xftpFileInvitation fileName (fromIntegral $ B.length $ strEncode vfd) dummyFileDescr
aFileId <- withAgent $ \a -> xftpSendDescription a (aUserId user) vfd (roundedFDCount 1)
aFileId <- withAgent $ \a -> xftpPrepareSendDescription a (aUserId user) vfd (roundedFDCount 1)
chSize <- asks $ fileChunkSize . config
withStore' $ \db -> createSndFileTransferXFTP db user Nothing file fInv (AgentSndFileId aFileId) (Just ftId) chSize
ft <- withStore' $ \db -> createSndFileTransferXFTP db user Nothing file fInv (AgentSndFileId aFileId) (Just ftId) chSize
ft <$ withAgent (`xftpStartSendFile` aFileId)
dummyFileDescr :: FileDescr
dummyFileDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
@@ -838,6 +844,16 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete}
rcvSize = max (toInteger encSize) redirectSize
-- 10 MB margin: encryption and chunk-size rounding make the transfer larger than the advertised size
maxRcvSize = min expectedFileSize (toInteger FD.maxFileSizeHard) + toInteger (FD.mb 10 :: Int64)
-- TODO re-enable redirects with relay checks
when (isJust redirect) $ do
cxt <- chatStoreCxt
aci_ <- withStore $ \db -> do
liftIO $ updateFileCancelled db user fileId (CIFSRcvError $ FileErrOther "redirect not allowed")
lookupChatItemByFileId db cxt user fileId
forM_ aci_ $ \aci -> do
cleanupACIFile aci
toView $ CEvtChatItemUpdated user aci
throwChatError $ CEInvalidFileDescription "redirect not allowed"
when (rcvSize > maxRcvSize) $ throwChatError $ CEFileRcvChunk "declared file size exceeds the file invitation size"
if userApprovedRelays
then receive' rd True
@@ -852,9 +868,10 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete}
where
receive' :: ValidFileDescription 'FRecipient -> Bool -> CM ()
receive' rd approved = do
aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd cfArgs approved
aFileId <- withAgent $ \a -> xftpPrepareReceiveFile a (aUserId user) rd cfArgs approved
startReceivingFile user fileId
withStore' $ \db -> updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId)
withAgent (`xftpStartReceiveFile` aFileId)
getUnknownSrvs :: [XFTPServer] -> CM [XFTPServer]
getUnknownSrvs srvs = do
knownSrvs <- L.map protoServer' <$> getKnownAgentServers SPXFTP user
@@ -905,13 +922,14 @@ receiveViaURI :: User -> FileDescriptionURI -> CryptoFile -> CM RcvFileTransfer
receiveViaURI user@User {userId} FileDescriptionURI {description} cf@CryptoFile {cryptoArgs} = do
fileId <- withStore $ \db -> createRcvStandaloneFileTransfer db userId cf fileSize chunkSize
-- currently the only use case is user migrating via their configured servers, so we pass approvedRelays = True
aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) description cryptoArgs True
withStore $ \db -> do
aFileId <- withAgent $ \a -> xftpPrepareReceiveFile a (aUserId user) description cryptoArgs True
ft <- withStore $ \db -> do
liftIO $ do
updateRcvFileStatus db fileId FSConnected
updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1
updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId)
getRcvFileTransfer db user fileId
ft <$ withAgent (`xftpStartReceiveFile` aFileId)
where
FD.ValidFileDescription FD.FileDescription {size = FD.FileSize fileSize, chunkSize = FD.FileSize chunkSize} = description
@@ -974,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)
@@ -1007,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
@@ -1020,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
@@ -1028,6 +1046,7 @@ acceptGroupJoinRequestAsync
cReqInvId
cReqChatVRange
cReqProfile
presHeader_
cReqXContactId_
cReqMemberId_
welcomeMsgId_
@@ -1046,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
@@ -1067,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
@@ -1087,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 $
@@ -1099,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
@@ -1134,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
@@ -1161,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
@@ -1175,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
@@ -1327,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} =
@@ -1400,7 +1422,7 @@ sendHistory user gInfo@GroupInfo {membership} m@GroupMember {activeConn = Just c
-- (regular groups only; never channels) is an authored element -- all batch together in order.
let fwdEls = map (uncurry encodeFwdElement) (concat fwdMsgsByItem)
welcomeEl <- welcomeElement
let (batches, dropped) = batchElements maxEncodedMsgLength (fwdEls <> maybe [] (: []) welcomeEl)
let (batches, dropped) = batchElements maxForwardBatchLength (fwdEls <> maybe [] (: []) welcomeEl)
when (dropped > 0) $ toView $ CEvtChatErrors [ChatError $ CEInternalError ("sendHistory: dropped " <> show dropped <> " oversized history messages")]
forM_ batches $ \body ->
void $ withAgent $ \a -> sendMessages a [(aConnId conn, PQEncOff, MsgFlags False, VRValue Nothing body)]
@@ -1538,9 +1560,7 @@ sendHistory user gInfo@GroupInfo {membership} m@GroupMember {activeConn = Just c
pure $ map ((,) fwd) (contentVM : fileDescrVMs)
memberShortenedName :: GroupMember -> ContactName
memberShortenedName GroupMember {memberProfile = LocalProfile {displayName}}
| T.length displayName <= 16 = displayName
| otherwise = T.take 16 displayName `T.snoc` '…'
memberShortenedName GroupMember {memberProfile = LocalProfile {displayName}} = fwdMemberName displayName
-- the description proof travels on the last part, so that part leaves room for it
badgeDescrPartSize :: Int
@@ -1633,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
@@ -2234,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
@@ -2315,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
@@ -2341,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_
@@ -2434,6 +2492,12 @@ batchSendConnMessagesB mode _user conn msgFlags msgs_ = do
batchSndMessagesJSON :: BatchMode -> NonEmpty (Either ChatError SndMessage) -> [Either ChatError MsgBatch]
batchSndMessagesJSON mode = batchMessages mode maxEncodedMsgLength . L.toList
compressToLimit :: MonadError ChatError m => Int -> MsgBody -> m MsgBody
compressToLimit maxLen = maybe (throwError $ ChatError $ CEException "large compressed body") pure . compressBodyTo maxLen
compressConnInfo :: PQSupport -> MsgBody -> CM MsgBody
compressConnInfo pqSup = compressToLimit $ e2eEncConnInfoLength pqSup - 2 - maxReplyQueueFraming
encodeConnInfo :: MsgEncodingI e => ChatMsgEvent e -> CM ByteString
encodeConnInfo = encodeConnInfoPQ PQSupportOff
@@ -2441,31 +2505,39 @@ encodeConnInfoPQ :: MsgEncodingI e => PQSupport -> ChatMsgEvent e -> CM ByteStri
encodeConnInfoPQ pqSup chatMsgEvent = do
cxt <- chatStoreCxt
let info = ChatMessage {chatVRange = vr cxt, msgId = Nothing, chatMsgEvent}
case encodeChatMessage maxEncodedInfoLength info of
ECMEncoded connInfo -> case pqSup of
-- with PQ off the size budget is larger, so the body always fits and compressing is wasted work
PQSupportOn -> maybe (throwChatError $ CEException "large compressed info") pure $ compressBodyTo maxCompressedInfoLength connInfo
_ -> pure connInfo
case encodeChatMessage maxEncodedProfileMsgLength info of
ECMEncoded connInfo -> compressConnInfo pqSup connInfo
ECMLarge -> throwChatError $ CEException "large info"
-- conn-info wrapped as a signed element, so the receiver can verify the signature over the body
encodeSignedConnInfo :: MsgEncodingI e => MsgSigning -> ChatMsgEvent e -> CM ByteString
encodeSignedConnInfo signing chatMsgEvent = do
encodeSignedConnInfo :: MsgEncodingI e => PQSupport -> MsgSigning -> ChatMsgEvent e -> CM ByteString
encodeSignedConnInfo pqSup signing chatMsgEvent = do
vr <- chatVersionRange
let info = ChatMessage {chatVRange = vr, msgId = Nothing, chatMsgEvent}
case encodeChatMessage maxEncodedInfoLength info of
ECMEncoded body -> pure $ encodeBatchElement (Just $ signChatMsgBody signing body) body
case encodeChatMessage maxEncodedProfileMsgLength info of
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 :: GroupInfoKeys -> MemberId -> Profile -> CM ByteString
encodeXMemberConnInfo (GIK gInfo@GroupInfo {membership = GroupMember {memberId}} gks) relayMemberId profileToSend =
encodeXMemberConnInfo :: PQSupport -> GroupInfoKeys -> MemberId -> Profile -> CM ByteString
encodeXMemberConnInfo pqSup (GIK gInfo@GroupInfo {membership = GroupMember {memberId}} gks) relayMemberId profileToSend =
let memberPrivKey' = memberPrivKey gks
xMemberEvt = XMember profileToSend memberId (MemberKey $ C.publicKey memberPrivKey') (Just relayMemberId)
bindingData = groupBindingData gInfo memberId (C.publicKey memberPrivKey')
signing = MsgSigning CBGroup bindingData KRMember memberPrivKey'
in encodeSignedConnInfo signing xMemberEvt
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
@@ -2489,19 +2561,20 @@ deliverMessages msgs = deliverMessagesB $ L.map Right msgs
deliverMessagesB :: NonEmpty (Either ChatError ChatMsgReq) -> CM (NonEmpty (Either ChatError ([Int64], PQEncryption)))
deliverMessagesB msgReqs = do
msgReqs' <- if any connSupportsPQ msgReqs then liftIO compressBodies else pure msgReqs
msgReqs' <- liftIO compressBodies
sent <- L.zipWith prepareBatch msgReqs' <$> withAgent (`sendMessagesB` snd (mapAccumL toAgent Nothing msgReqs'))
lift . void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights . L.toList $ sent)
lift . withStoreBatch $ \db -> L.map (bindRight $ createDelivery db) sent
where
-- group sends share bodies between connections via VRRef, so the smallest limit applies to the batch
maxLen = if any connSupportsPQ msgReqs then maxEncodedMsgLengthPQ else maxEncodedMsgLength
connSupportsPQ = \case
Right (Connection {pqSupport = PQSupportOn}, _, _) -> True
_ -> False
compressBodies =
forME msgReqs $ \(conn, msgFlags, (mbr, msgIds)) -> runExceptT $ do
mbr' <- case mbr of
VRValue i msgBody ->
VRValue i <$> maybe (throwError $ ChatError $ CEException "large compressed message") pure (compressBodyTo maxCompressedMsgLength msgBody)
VRValue i msgBody -> VRValue i <$> compressToLimit maxLen msgBody
v -> pure v
pure (conn, msgFlags, (mbr', msgIds))
toAgent prev = \case
@@ -2645,7 +2718,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
@@ -3019,13 +3092,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 =
@@ -3036,9 +3107,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 signing msg
Nothing -> encodeConnInfoPQ pqSupport msg
dm <- encodeConnInfoSigning pqSupport signing_ msg
allowAgentConnectionInfo user conn confId dm
allowAgentConnectionInfo :: User -> Connection -> ConfirmationId -> ByteString -> CM ()
@@ -3047,11 +3116,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
src/Simplex/Chat/Library/Subscriber.hs
+278 -195
View File
@@ -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
@@ -115,10 +115,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
@@ -140,13 +151,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))
@@ -435,7 +446,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
@@ -445,8 +456,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
@@ -500,10 +511,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
@@ -620,7 +630,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
@@ -633,7 +643,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
@@ -658,7 +668,6 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
ct' = ct {activeConn = Just conn'} :: Contact
-- [incognito] print incognito profile used for this contact
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
toView $ CEvtContactConnected user ct' (fmap fromLocalProfile incognitoProfile)
let createE2EItem = createInternalChatItem user (CDDirectRcv ct') (CIRcvDirectE2EEInfo $ e2eInfoEncrypted $ Just pqEnc) Nothing
-- TODO [short links] get contact request by contactRequestId, check encryption (UserContactRequest.pqSupport)?
when (directOrUsed ct') $ case (preparedContact ct', contactRequestId' ct') of
@@ -673,6 +682,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
withStore' (\db -> getContactRequest' db user connReqId) >>= \case
Just UserContactRequest {pqSupport} | CR.pqSupportToEnc pqSupport == pqEnc -> pure ()
_ -> createE2EItem
toView $ CEvtContactConnected user ct' (fmap fromLocalProfile incognitoProfile)
when (contactConnInitiated conn') $ do
probeMatchingMembers ct' (contactConnIncognito ct')
withStore' $ \db -> resetContactConnInitiated db user conn'
@@ -773,21 +783,25 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
hostConnId <- withStore $ \db -> do
liftIO $ setConnConnReqInv db user connId cReq
getHostConnId db user groupId
sendXGrpMemInv hostConnId Nothing XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq}
sendXGrpMemInv hostConnId XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq}
_ -> 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
@@ -822,7 +836,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"
@@ -833,31 +847,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
@@ -883,7 +898,6 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
pure gInfo {membership = membership {memberStatus = GSMemConnected}}
else pure gInfo
pure (m {memberStatus = GSMemConnected}, gInfo')
toView $ CEvtUserJoinedGroup user gInfo' m'
when (isRelay membership) $ do
cc <- ask
atomically $ channelProfileUpdated cc groupId groupProfile
@@ -897,10 +911,14 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
let prepared = preparedGroup gInfo''
unless (isJust prepared) $ createGroupFeatureItems user cd CIRcvGroupFeature gInfo''
memberConnectedChatItem gInfo'' scopeInfo m''
toView $ CEvtUserJoinedGroup user gInfo' m'
let welcomeMsgId_ = (\PreparedGroup {welcomeSharedMsgId = mId} -> mId) <$> prepared
unless (memberPending membership || isJust welcomeMsgId_) $ maybeCreateGroupDescrLocal gInfo'' m''
)
(memberConnectedChatItem gInfo'' scopeInfo m'')
( do
memberConnectedChatItem gInfo'' scopeInfo m''
toView $ CEvtUserJoinedGroup user gInfo' m'
)
where
firstConnectedHost
| useRelays' gInfo = do
@@ -963,7 +981,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
@@ -1088,7 +1106,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
@@ -1102,6 +1120,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
XGrpRoster gr -> fmap ctx <$> xGrpRoster gInfo' m'' m'' gr verifiedMsg sharedMsgId_ brokerTs
XGrpRosterAck ackVer ackErr -> Nothing <$ xGrpRosterAck (GIK gInfo' gks) m'' ackVer ackErr
XGrpRosterRequest reqVer -> Nothing <$ xGrpRosterRequest (GIK gInfo' gks) m'' reqVer
XGrpInv gInv -> Nothing <$ xGrpInv gInfo' m'' conn' gInv msg brokerTs
-- TODO [knocking] why don't we forward these messages?
XGrpDirectInv connReq mContent_ msgScope -> memberCanSend (Just m'') msgScope $ Nothing <$ xGrpDirectInv gInfo' m'' conn' connReq mContent_ msg brokerTs
XGrpMsgForward fwd msg' -> Nothing <$ xGrpMsgForward (GIK gInfo' gks) Nothing m'' fwd (ParsedMsg Nothing Nothing msg') brokerTs
@@ -1245,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
dm <- encodeXMemberConnInfo g relayMemberId profileToSend
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
@@ -1389,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 ()
@@ -1469,8 +1489,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
@@ -1480,7 +1500,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
@@ -1623,7 +1643,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'
@@ -1633,16 +1653,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 >= groupInvVersion && 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_ =
@@ -1653,7 +1678,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
@@ -1669,27 +1694,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'
@@ -2679,27 +2704,14 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
| otherwise = do
let Contact {localDisplayName = c, activeConn} = ct
GroupInvitation {fromMember = (MemberIdRole fromMemId fromRole), invitedMember = (MemberIdRole memId memRole), connRequest, groupLinkId} = inv
forM_ activeConn $ \Connection {connId, connChatVersion, peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'} -> do
forM_ activeConn $ \conn@Connection {peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'} -> do
when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c)
when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId
-- [incognito] if direct connection with host is incognito, create membership using the same incognito profile
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
(g@(GIK gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership} _), hostId) <- withStore $ \db -> createGroupInvitation db cxt user (Left ct) peerChatVRange inv customUserProfileId memberKeys
void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart)
let GroupMember {groupMemberId, memberId = membershipMemId} = 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
withStore' $ \db -> do
when sameLink $ setViaGroupLinkUri db groupId connId
createMemberConnectionAsync db user hostId connIds connChatVersion peerChatVRange subMode
updateGroupMemberStatusById db userId hostId GSMemAccepted
updateGroupMemberStatus db userId membership GSMemAccepted
joinAgentConnectionAsync cmdId False acId True connRequest dm subMode
toView $ CEvtUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} hostContact_
let GroupMember {groupMemberId} = membership
createInvitationItem invStatus = do
let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = invStatus}) memRole
(ci, cInfo) <- saveRcvChatItemNoParse user (CDDirectRcv ct) msg brokerTs content
@@ -2707,11 +2719,11 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv cInfo ci]
if
| sameGroupLinkId groupLinkId groupLinkId' ->
joinGroupAsync (Just ct) True
joinGroupAsync g hostId conn connRequest (Just ct) True
| isTrue (autoAcceptGroupInvitations user) ->
-- a resent invitation returns the existing group, so only join while still invited
when (memberStatus membership == GSMemInvited) $ do
joinGroupAsync Nothing False
joinGroupAsync g hostId conn connRequest Nothing False
createInvitationItem CIGISAccepted
| otherwise -> do
createInvitationItem CIGISPending
@@ -2723,6 +2735,21 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
sameGroupLinkId (Just gli) (Just gli') = gli == gli'
sameGroupLinkId _ _ = False
-- hostContact is only reported for group links, where the client replaces
-- the transient host connection view with the group and removes its chat
joinGroupAsync :: GroupInfoKeys -> GroupMemberId -> Connection -> ConnReqInvitation -> Maybe Contact -> Bool -> CM ()
joinGroupAsync (GIK gInfo@GroupInfo {groupId, membership} gks) hostId Connection {connId, connChatVersion, peerChatVRange} connRequest hostContact_ sameLink = do
subMode <- chatReadVar subscriptionMode
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
updateGroupMemberStatusById db userId hostId GSMemAccepted
updateGroupMemberStatus db userId membership GSMemAccepted
joinAgentConnectionAsync cmdId False acId True connRequest dm subMode
toView $ CEvtUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} hostContact_
checkIntegrityCreateItem :: forall c. ChatTypeI c => ChatDirection c 'MDRcv -> MsgMeta -> CM ()
checkIntegrityCreateItem cd MsgMeta {integrity, broker = (_, brokerTs)} = case integrity of
MsgOk -> pure ()
@@ -2753,25 +2780,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'
@@ -2785,20 +2815,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 ()
@@ -2806,27 +2836,35 @@ 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
| memberRole' m < GRModerator || memberRole' m < role =
-- same rule as role change (moderators grant up to member); pending member's role is a stand-in, so treat it as member
| memberRole' m < roleRequiredToChange GRMember role =
messageError "x.grp.link.acpt with insufficient member permissions"
| sameMemberId memberId membership = processUserAccepted
| otherwise =
@@ -2882,38 +2920,38 @@ 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'
Just mContactId -> do
mCt <- withStore $ \db -> getContact db cxt user mContactId
if canUpdateProfile mCt
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
where
canUpdateProfile ct
| not (contactActive ct) = True
| otherwise = case contactConn ct of
Nothing -> True
Just conn -> not (connReady conn) || (authErrCounter conn >= 1)
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
@@ -3009,15 +3047,23 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
-- to party accepting call
xCallInv :: Contact -> CallId -> CallInvitation -> RcvMessage -> MsgMeta -> CM ()
xCallInv ct@Contact {contactId} callId CallInvitation {callType, callDhPubKey} msg@RcvMessage {sharedMsgId_} msgMeta = do
xCallInv ct@Contact {contactId} callId CallInvitation {callType, callDhPubKey, callVRange = peerCallVRange} msg@RcvMessage {sharedMsgId_} msgMeta = do
if featureAllowed SCFCalls forContact ct
then do
ChatConfig {callVRange = callVR} <- asks config
case callVR `compatibleVersion` maybe callInitialVRange fromCallVRange peerCallVRange of
Just (Compatible callVersion) -> createCallInvitation callVersion
Nothing -> messageError "x.call.inv: incompatible call version"
else featureRejected CFCalls
where
brokerTs = metaBrokerTs msgMeta
createCallInvitation callVersion = do
g <- asks random
dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing
(ci, cInfo) <- saveCallItem CISCallPending
callUUID <- UUID.toText <$> liftIO V4.nextRandom
let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> (snd <$> dhKeyPair))
callState = CallInvitationReceived {peerCallType = callType, localDhPubKey = fst <$> dhKeyPair, sharedKey}
let sharedKey = callMediaKey callVersion callId <$> callDhPubKey <*> (snd <$> dhKeyPair)
callState = CallInvitationReceived {peerCallType = callType, localDhPubKey = fst <$> dhKeyPair, sharedKey, callVersion = Just callVersion}
call' = Call {contactId, callId, callUUID, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
calls <- asks currentCalls
-- theoretically, the new call invitation for the current contact can mark the in-progress call as ended
@@ -3028,9 +3074,6 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing
toView $ CEvtCallInvitation RcvCallInvitation {user, contact = ct, callType, sharedKey, callUUID, callTs = chatItemTs' ci}
toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv cInfo ci]
else featureRejected CFCalls
where
brokerTs = metaBrokerTs msgMeta
saveCallItem status = saveRcvChatItemNoParse user (CDDirectRcv ct) msg brokerTs (CIRcvCall status 0)
featureRejected f = do
let content = ciContentNoParse $ CIRcvChatFeatureRejected f
@@ -3039,18 +3082,25 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
-- to party initiating call
xCallOffer :: Contact -> CallId -> CallOffer -> RcvMessage -> CM ()
xCallOffer ct callId CallOffer {callType, rtcSession, callDhPubKey} msg = do
xCallOffer ct callId CallOffer {callType, rtcSession, callDhPubKey, callVersion = peerCallVersion} msg = do
ChatConfig {callVRange = callVR} <- asks config
msgCurrentCall ct callId "x.call.offer" msg $
\call -> case callState call of
CallInvitationSent {localCallType, localDhPrivKey} -> do
let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> localDhPrivKey)
callState' = CallOfferReceived {localCallType, peerCallType = callType, peerCallSession = rtcSession, sharedKey}
askConfirmation = encryptedCall localCallType && not (encryptedCall callType)
toView CEvtCallOffer {user, contact = ct, callType, offer = rtcSession, sharedKey, askConfirmation}
pure (Just call {callState = callState'}, Just . ACIContent SMDSnd $ CISndCall CISCallAccepted 0)
CallInvitationSent {localCallType, localDhPrivKey}
| callVersion `isCompatible` callVR -> do
let sharedKey = callMediaKey callVersion callId <$> callDhPubKey <*> localDhPrivKey
callState' = CallOfferReceived {localCallType, peerCallType = callType, peerCallSession = rtcSession, sharedKey}
askConfirmation = encryptedCall localCallType && isNothing sharedKey
toView CEvtCallOffer {user, contact = ct, callType, offer = rtcSession, sharedKey, askConfirmation}
pure (Just call {callState = callState'}, Just . ACIContent SMDSnd $ CISndCall CISCallAccepted 0)
| otherwise -> do
messageError "x.call.offer: unsupported call version"
pure (Just call, Nothing)
_ -> do
msgCallStateError "x.call.offer" call
pure (Just call, Nothing)
where
callVersion = fromMaybe initialCallVersion peerCallVersion
-- to party accepting call
xCallAnswer :: Contact -> CallId -> CallAnswer -> RcvMessage -> CM ()
@@ -3155,8 +3205,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
@@ -3180,6 +3231,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
@@ -3196,7 +3248,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
@@ -3207,7 +3259,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
@@ -3225,7 +3277,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
@@ -3266,7 +3318,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"
@@ -3279,7 +3331,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
@@ -3289,15 +3341,15 @@ 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"
sendXGrpMemInv :: Int64 -> Maybe ConnReqInvitation -> XGrpMemIntroCont -> CM ()
sendXGrpMemInv hostConnId directConnReq XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} = do
sendXGrpMemInv :: Int64 -> XGrpMemIntroCont -> CM ()
sendXGrpMemInv hostConnId XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} = do
hostConn <- withStore $ \db -> getConnectionById db cxt user hostConnId
let msg = XGrpMemInv memberId IntroInvitation {groupConnReq, directConnReq}
let msg = XGrpMemInv memberId IntroInvitation {groupConnReq}
void $ sendDirectMemberMessage hostConn msg groupId
withStore' $ \db -> updateGroupMemberStatusById db userId groupMemberId GSMemIntroInvited
@@ -3310,8 +3362,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, directConnReq} = 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
@@ -3322,7 +3374,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.?
@@ -3331,20 +3383,18 @@ 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, create direct connection as incognito
membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile gInfo membership $ fromLocalProfile $ memberProfile membership
dm <- encodeConnInfo $ XGrpMemInfo membershipMemId membershipProfile
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 Nothing enableNtfsGrp groupConnReq
directConnIds <- mapM (prepareAgentJoin user Nothing True) directConnReq
let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
chatV = vr cxt `peerConnChatVersion` mcvr
withStore' $ \db -> createIntroToMemberContact db user m toMember chatV mcvr groupConnIds directConnIds customUserProfileId subMode
(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
forM_ ((,) <$> directConnIds <*> directConnReq) $ \((dCmdId, dAcId), dcr) ->
joinAgentConnectionAsync dCmdId False dAcId True dcr dm subMode
-- rollback defense (channels): apply an owner-signed role/removal only at a version >= the persisted
-- roster_version (not the batch-constant gInfo, which a relay can stale by reordering events in one
@@ -3835,6 +3885,35 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
unless (isUserGrpFwdRelay gInfo) $ connectToRelayAsync user gInfo rl
pure $ Just DJSGroup {jobSpec = DJDeliveryJob {includePending = False}}
xGrpInv :: GroupInfo -> GroupMember -> Connection -> GroupInvitation -> RcvMessage -> UTCTime -> CM ()
xGrpInv viaGInfo m mConn@Connection {peerChatVRange} inv msg brokerTs
| useRelays' viaGInfo = messageError "x.grp.inv: not allowed in channels"
| isJust publicGroup = messageError "x.grp.inv: can't invite to channel"
| not (groupFeatureMemberAllowed SGFDirectMessages m viaGInfo) = messageError "x.grp.inv: direct messages not allowed"
| memberBlocked m = messageWarning "x.grp.inv: member is blocked (ignoring)"
| fromRole < GRAdmin || fromRole < memRole = messageError "x.grp.inv: inviting member role"
| fromMemId == memId = messageError "x.grp.inv: duplicate member ID"
| otherwise = do
memberKeys <- atomically . C.generateKeyPair =<< asks random
let incognitoProfileId = localProfileId <$> incognitoMembershipProfile viaGInfo
(g@(GIK gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership} _), hostId) <- withStore $ \db -> createGroupInvitation db cxt user (Right m) peerChatVRange inv incognitoProfileId memberKeys
void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart)
let GroupMember {groupMemberId} = membership
createInvitationItem invStatus = do
let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = invStatus}) memRole
(ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv viaGInfo Nothing m) msg brokerTs content
withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci)
groupMsgToView cInfo ci
if isTrue (autoAcceptGroupInvitations user)
then when (memberStatus membership == GSMemInvited) $ do
joinGroupAsync g hostId mConn connRequest Nothing False
createInvitationItem CIGISAccepted
else do
createInvitationItem CIGISPending
toView CEvtReceivedGroupInvitationViaGroup {user, groupInfo = gInfo, viaGroupInfo = viaGInfo, viaMember = m, fromMemberRole = fromRole, memberRole = memRole}
where
GroupInvitation {fromMember = MemberIdRole fromMemId fromRole, invitedMember = MemberIdRole memId memRole, connRequest, groupProfile = GroupProfile {publicGroup}} = inv
xGrpDirectInv :: GroupInfo -> GroupMember -> Connection -> ConnReqInvitation -> Maybe MsgContent -> RcvMessage -> UTCTime -> CM ()
xGrpDirectInv g@GroupInfo {groupId, groupProfile = gp} m mConn@Connection {connId = mConnId} connReq mContent_ msg brokerTs
| not (groupFeatureMemberAllowed SGFDirectMessages m g) = messageError "x.grp.direct.inv: direct messages not allowed"
@@ -3868,12 +3947,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
@@ -3887,14 +3966,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
@@ -3907,9 +3986,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
@@ -3927,7 +4006,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
xGrpMsgForward :: GroupInfoKeys -> Maybe GroupChatScopeInfo -> GroupMember -> GrpMsgForward -> ParsedMsg 'Json -> UTCTime -> CM ()
xGrpMsgForward g@(GIK gInfo _) scopeInfo m@GroupMember {localDisplayName} GrpMsgForward {fwdSender, fwdBrokerTs = msgTs} parsedMsg@(ParsedMsg _ _ chatMsg@ChatMessage {chatMsgEvent}) brokerTs = do
xGrpMsgForward g@(GIK gInfo@GroupInfo {membership} _) scopeInfo m@GroupMember {localDisplayName} GrpMsgForward {fwdSender, fwdBrokerTs = msgTs} parsedMsg@(ParsedMsg _ _ chatMsg@ChatMessage {chatMsgEvent}) brokerTs = do
unless (isMemberGrpFwdRelay gInfo m) $ throwChatError (CEGroupContactRole localDisplayName)
case fwdSender of
FwdMember memberId memberName -> do
@@ -3935,6 +4014,8 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag
let allowCreate = toCMEventTag chatMsgEvent /= XGrpLeave_
withStore (\db -> getCreateUnknownGMByMemberId db cxt user gInfo memberId memberName unknownRole allowCreate) >>= \case
Just (author, unknown)
| not (useRelays' gInfo) && groupMemberId' author == groupMemberId' membership ->
messageError $ "x.grp.msg.forward: content attributed to own membership, forwarder " <> tshow (groupMemberId' m) <> ", event " <> tshow (toCMEventTag chatMsgEvent)
| memberRemoved author ->
logInfo $ "x.grp.msg.forward: ignoring content from removed member, group " <> tshow (groupId' gInfo) <> ", member " <> safeDecodeUtf8 (strEncode memberId) <> ", event " <> tshow (toCMEventTag chatMsgEvent)
| not (useRelays' gInfo) && not (expectedForwarder author) ->
@@ -4150,7 +4231,7 @@ runDeliveryTaskWorker a deliveryKey Worker {doWork} = do
withStore' $ \db -> setDeliveryTaskErrStatus db (deliveryTaskId task) "relay inactive"
| otherwise ->
withWorkItems a doWork (withStore' $ \db -> getNextDeliveryTasks db gInfo task) $ \nextTasks -> do
let (body_, acceptedTasks, largeTasks) = batchDeliveryTasks1 (vr cxt) maxEncodedMsgLength nextTasks
let (body_, acceptedTasks, largeTasks) = batchDeliveryTasks1 (vr cxt) maxForwardBatchLength nextTasks
senderGMIds = S.toList . S.fromList $ map (\MessageDeliveryTask {senderGMId} -> senderGMId) acceptedTasks
withStore' $ \db -> do
forM_ body_ $ \body -> createMsgDeliveryJob db gInfo jobScope senderGMIds body
@@ -4280,8 +4361,8 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
else do
-- all members' profiles disseminate; privileged key/role come from the roster, not here
let (encoderErrs, validLabeled) = partitionEithers [(\bs -> (s, bs)) <$> encodeMemberNew (vr cxt) gInfo s | (s, _) <- senders]
(extBody', inBody, overflowLabeled, large1) = batchProfilesWithBody maxEncodedMsgLength body validLabeled
(overflowBatches', large2) = batchProfiles maxEncodedMsgLength overflowLabeled
(extBody', inBody, overflowLabeled, large1) = batchProfilesWithBody maxForwardBatchLength body validLabeled
(overflowBatches', large2) = batchProfiles maxForwardBatchLength overflowLabeled
packerErrs = [ChatError (CEInternalError $ "oversized profile element for member " <> show (groupMemberId' s)) | s <- large1 <> large2]
allErrs = encoderErrs <> packerErrs
unless (null allErrs) $ do
@@ -4486,22 +4567,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"
@@ -4511,8 +4593,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
@@ -4547,7 +4631,6 @@ runRelayRequestWorker a Worker {doWork} = do
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
src/Simplex/Chat/Markdown.hs
+5 -5
View File
@@ -518,11 +518,11 @@ displayNameTextP_ = (,"") <$> quoted '\'' <|> splitPunctuation <$> takeNameTill
refChar c = c > ' ' && c /= '#' && c /= '@' && c /= '\''
commandTextP :: Parser (Text, Text)
commandTextP = do
(cmd, punct) <- displayNameTextP_
case T.words cmd of
(keyword : _) | T.all (\c -> isAlpha c || isDigit c || c == '_') keyword -> pure (cmd, punct)
_ -> fail "invalid command keyword"
commandTextP = commandText <$> displayNameTextP_
where
commandText (cmd, punct)
| T.null cmd = (punct, "")
| otherwise = (cmd, punct)
splitPunctuation :: Text -> (Text, Text)
splitPunctuation s = (T.dropWhileEnd isPunctuation s, T.takeWhileEnd isPunctuation s)
src/Simplex/Chat/Messages.hs
+2 -2
View File
@@ -55,7 +55,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, sumTypeJSON)
import Simplex.Messaging.Protocol (BlockingInfo, MsgBody, XFTPServer)
import Simplex.Messaging.Protocol (BlockingInfo, MsgBody, XFTPServer, unMsgId)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
data ChatType = CTDirect | CTGroup | CTLocal | CTContactRequest | CTContactConnection
@@ -1228,7 +1228,7 @@ msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId
{ integrity = (decodeLatin1 . strEncode) integrity,
rcvId,
rcvTs,
serverId = (decodeLatin1 . B64.encode) serverId,
serverId = (decodeLatin1 . B64.encode . unMsgId) serverId,
serverTs,
sndId
}
src/Simplex/Chat/Operators.hs
+5 -1
View File
@@ -525,6 +525,7 @@ data UserServersError
| USEStorageMissing {protocol :: AProtocolType, user :: Maybe User}
| USEProxyMissing {protocol :: AProtocolType, user :: Maybe User}
| USEDuplicateServer {protocol :: AProtocolType, duplicateServer :: Text, duplicateHost :: TransportHost}
| USETooManyHosts {protocol :: AProtocolType, tooManyHostsServer :: Text}
| USEDuplicateChatRelayAddress {duplicateChatRelay :: Text, duplicateAddress :: ShortLinkContact}
deriving (Show)
@@ -547,13 +548,16 @@ validateUserServers curr others = (currUserErrs <> concatMap otherUserErrs other
noServers cond = not $ any srvEnabled $ userServers p $ filter cond uss
srvEnabled (AUS _ UserServer {deleted, enabled}) = enabled && not deleted
serverErrs :: (UserServersClass u, ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [u] -> [UserServersError]
serverErrs p uss = mapMaybe duplicateErr_ srvs
serverErrs p uss = mapMaybe duplicateErr_ srvs <> hostsErrs
where
p' = AProtocolType p
srvs = filter (\(AUS _ UserServer {deleted}) -> not deleted) $ userServers p uss
duplicateErr_ (AUS _ srv@UserServer {server}) =
USEDuplicateServer p' (safeDecodeUtf8 $ strEncode server)
<$> find (`S.member` duplicateHosts) (srvHost srv)
hostsErrs = case p of
SPSMP -> [USETooManyHosts p' (safeDecodeUtf8 $ strEncode server) | AUS _ srv@UserServer {server} <- srvs, L.length (srvHost srv) > 2]
_ -> []
duplicateHosts = snd $ foldl' addDuplicate (S.empty, S.empty) allHosts
allHosts = concatMap (\(AUS _ srv) -> L.toList $ srvHost srv) srvs
userServers :: (UserServersClass u, UserProtocol p) => SProtocolType p -> [u] -> [AUserServer p]
src/Simplex/Chat/PaymentService/Types.hs
+1 -1
View File
@@ -66,7 +66,7 @@ data ServicePaymentDestination
address :: Text,
cryptoAmount :: Text
}
deriving (Show)
deriving (Eq, Show)
-- confirmed
data InvoiceStatus = ISOpen | ISPaid | ISExpired
src/Simplex/Chat/Protocol.hs
+44 -14
View File
@@ -57,9 +57,11 @@ import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import qualified Simplex.FileTransfer.Description as FD
import Simplex.Messaging.Agent.Protocol (e2eEncConnInfoLength)
import Simplex.Messaging.Agent.Store.DB (blobFieldDecoder, fromTextField_)
import Simplex.Messaging.Compression (Compressed, compress1, decompress1, decompressedSize)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOn)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
@@ -87,12 +89,14 @@ import Simplex.Messaging.Version hiding (version)
-- 18 - relay web capabilities (2026-05-31)
-- 19 - group roster (2026-06-18)
-- 20 - p2p group member keys for signing (2026-07-26)
-- 21 - command keywords with any characters (2026-09-27)
-- 22 - owner-signed relay invitations, group invitations via member connections (2026-10-10)
-- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig.
-- 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 20
currentChatVersion = VersionChat 22
-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
supportedChatVRange :: VersionRangeChat
@@ -140,6 +144,12 @@ groupRosterVersion = VersionChat 19
groupMemberKeyVersion :: VersionChat
groupMemberKeyVersion = VersionChat 20
anyTextCommandsVersion :: VersionChat
anyTextCommandsVersion = VersionChat 21
groupInvVersion :: VersionChat
groupInvVersion = VersionChat 22
data ConnectionEntity
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
| RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
@@ -465,7 +475,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
@@ -921,9 +931,17 @@ $(JQ.deriveJSON defaultJSON ''MsgContainer)
maxEncodedMsgLength :: Int
maxEncodedMsgLength = 15602
maxForwardBatchLength :: Int
maxForwardBatchLength = maxEncodedMsgLength + 161
fwdMemberName :: ContactName -> ContactName
fwdMemberName displayName
| T.length displayName <= 16 = displayName
| otherwise = T.take 16 displayName `T.snoc` '…'
-- maxEncodedMsgLength - 2222, see e2eEncUserMsgLength in agent
maxCompressedMsgLength :: Int
maxCompressedMsgLength = 13380
maxEncodedMsgLengthPQ :: Int
maxEncodedMsgLengthPQ = 13380
maxDecompressedMsgLength :: Int
maxDecompressedMsgLength = 65536
@@ -932,6 +950,9 @@ maxDecompressedMsgLength = 65536
maxBatchElementCount :: Int
maxBatchElementCount = 255
maxFwdDepth :: Int
maxFwdDepth = 1
-- Defensive entry-count bound for the roster blob parser (rosterBlobP) and the
-- promotion cap over the promoted (member/moderator/admin) set.
maxGroupRosterSize :: Int
@@ -959,8 +980,11 @@ rosterBlobP = do
maxEncodedInfoLength :: Int
maxEncodedInfoLength = 14694
maxCompressedInfoLength :: Int
maxCompressedInfoLength = 10968 -- maxEncodedInfoLength - 3726, see e2eEncConnInfoLength in agent
maxEncodedProfileMsgLength :: Int
maxEncodedProfileMsgLength = 16384
maxReplyQueueFraming :: Int
maxReplyQueueFraming = 256
data EncodedChatMessage = ECMEncoded ByteString | ECMLarge
@@ -1047,10 +1071,14 @@ compressBodyTo maxLen body
where
body' = compressedBatchMsgBody_ body
-- A service payload is padded to the same size as connection info, so it gets the same bound.
-- JSON never starts with 'X', so that marker unambiguously means the body is compressed.
compressServiceBody :: ByteString -> Either String ByteString
compressServiceBody = maybe (Left "service payload is too large") Right . compressBodyTo maxCompressedInfoLength
compressServiceBody = maybe (Left "service payload is too large") Right . compressBodyTo maxServiceBodyLength
-- A service payload is padded as PQ connection info, and a request also carries its reply queue
-- and an optional signature (111 bytes encoded), so both directions get the request's bound.
maxServiceBodyLength :: Int
maxServiceBodyLength = e2eEncConnInfoLength PQSupportOn - 2 - maxReplyQueueFraming - 111
decompressServiceBody :: ByteString -> Either String ByteString
decompressServiceBody body = case B.uncons body of
@@ -1390,6 +1418,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).
@@ -1426,8 +1455,8 @@ appBinaryToCM AppMessageBinary {msgId, tag, body} = do
msg = \case
BFileChunk_ -> BFileChunk <$> (SharedMsgId <$> smpP) <*> (unIFC <$> smpP)
appJsonToCM :: AppMessageJson -> Either String (ChatMessage 'Json)
appJsonToCM AppMessageJson {v, msgId, event, params} = do
appJsonToCM :: Int -> AppMessageJson -> Either String (ChatMessage 'Json)
appJsonToCM fwdDepth AppMessageJson {v, msgId, event, params} = do
eventTag <- strDecode $ encodeUtf8 event
chatMsgEvent <- msg eventTag
pure ChatMessage {chatVRange = maybe chatInitialVRange fromChatVRange v, msgId, chatMsgEvent}
@@ -1469,7 +1498,7 @@ appJsonToCM 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"
@@ -1502,11 +1531,12 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
XGrpRosterAck_ -> XGrpRosterAck <$> p "version" <*> opt "error"
XGrpRosterRequest_ -> XGrpRosterRequest <$> opt "version"
XGrpMsgForward_ -> do
when (fwdDepth >= maxFwdDepth) $ Left "forward depth exceeds limit"
fwdSender <- opt "memberId" >>= \case
Just memberId -> FwdMember memberId . fromMaybe "" <$> opt "memberName"
Nothing -> pure FwdChannel
fwdBrokerTs <- p "msgTs"
XGrpMsgForward (GrpMsgForward {fwdSender, fwdBrokerTs}) <$> p "msg"
XGrpMsgForward (GrpMsgForward {fwdSender, fwdBrokerTs}) <$> (appJsonToCM (fwdDepth + 1) =<< p "msg")
XInfoProbe_ -> XInfoProbe <$> p "probe"
XInfoProbeCheck_ -> XInfoProbeCheck <$> p "probeHash"
XInfoProbeOk_ -> XInfoProbeOk <$> p "probe"
@@ -1545,7 +1575,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]
@@ -1619,7 +1649,7 @@ instance ToJSON (ChatMessage 'Json) where
toJSON = (\(AMJson msg) -> toJSON msg) . chatToAppMessage
instance FromJSON (ChatMessage 'Json) where
parseJSON v = appJsonToCM <$?> parseJSON v
parseJSON v = appJsonToCM 0 <$?> parseJSON v
instance FromField (ChatMessage 'Json) where
fromField = blobFieldDecoder J.eitherDecodeStrict'
src/Simplex/Chat/Remote.hs
+3 -3
View File
@@ -75,11 +75,11 @@ remoteFilesFolder = "simplex_v1_files"
-- when acting as host
minRemoteCtrlVersion :: AppVersion
minRemoteCtrlVersion = AppVersion [7, 1, 0, 5]
minRemoteCtrlVersion = AppVersion [7, 1, 0, 11]
-- when acting as controller
minRemoteHostVersion :: AppVersion
minRemoteHostVersion = AppVersion [7, 1, 0, 5]
minRemoteHostVersion = AppVersion [7, 1, 0, 11]
currentAppVersion :: AppVersion
currentAppVersion = AppVersion SC.version
@@ -517,7 +517,7 @@ handleRemoteCommand execCC encryption remoteOutputQ HTTP2Request {request, reqBo
where
parseRequest :: ExceptT RemoteProtocolError IO (C.SbKeyNonce, GetChunk, RemoteCommand)
parseRequest = do
(rfKN, header, getNext) <- parseDecryptHTTP2Body encryption request reqBody
(rfKN, header, getNext) <- parseDecryptHTTP2Body maxCommandBodySize encryption request reqBody
(rfKN,getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecodeStrict header)
replyError = reply . RRChatResponse . RRError
processCommand :: User -> C.SbKeyNonce -> GetChunk -> RemoteCommand -> CM ()
src/Simplex/Chat/Remote/Protocol.hs
+13 -9
View File
@@ -40,7 +40,8 @@ import Simplex.Chat.Controller
import Simplex.Chat.Remote.Transport
import Simplex.Chat.Remote.Types
import Simplex.Chat.Types (BoolDef (..))
import Simplex.FileTransfer.Description (FileDigest (..))
import Simplex.FileTransfer.Description (FileDigest (..), mb)
import Simplex.Messaging.Compression (limitDecompress')
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..))
import Simplex.Messaging.Crypto.Lazy (LazyByteString)
@@ -180,7 +181,7 @@ sendRemoteCommand RemoteHostClient {httpClient, hostEncoding, encryption} file_
encFile_ <- mapM (prepareEncryptedFile sfKN) file_
let req = httpRequest encFile_ encCmd
HTTP2Response {response, respBody} <- liftError' (RPEHTTP2 . tshow) $ sendRequestDirect httpClient req Nothing
(rfKN, header, getNext) <- parseDecryptHTTP2Body encryption response respBody
(rfKN, header, getNext) <- parseDecryptHTTP2Body maxResponseBodySize encryption response respBody
rr <- liftEitherWith (RPEInvalidJSON . fromString) $ J.eitherDecodeStrict header >>= JT.parseEither J.parseJSON . convertJSON hostEncoding localEncoding
pure (rfKN, getNext, rr)
where
@@ -273,9 +274,15 @@ encryptEncodeHTTP2Body corrId cmdKN RemoteCrypto {sessionCode, signatures, compr
sign :: C.PrivateKeyEd25519 -> CH.Context SHA512 -> ByteString
sign k = C.signatureBytes . C.sign' k . BA.convert . CH.hashFinalize
maxCommandBodySize :: Int
maxCommandBodySize = mb 64
maxResponseBodySize :: Int
maxResponseBodySize = mb 512
-- | Parse and decrypt HTTP2 request/response
parseDecryptHTTP2Body :: HTTP2BodyChunk a => RemoteCrypto -> a -> HTTP2Body -> ExceptT RemoteProtocolError IO (C.SbKeyNonce, ByteString, Int -> IO ByteString)
parseDecryptHTTP2Body rc@RemoteCrypto {sessionCode, signatures, compression} hr HTTP2Body {bodyBuffer} = do
parseDecryptHTTP2Body :: HTTP2BodyChunk a => Int -> RemoteCrypto -> a -> HTTP2Body -> ExceptT RemoteProtocolError IO (C.SbKeyNonce, ByteString, Int -> IO ByteString)
parseDecryptHTTP2Body maxSize rc@RemoteCrypto {sessionCode, signatures, compression} hr HTTP2Body {bodyBuffer} = do
(corrId, ct) <- getBody
(cmdKN, rfKN) <- ExceptT $ atomically $ getRemoteRcvKeys rc corrId
s <- liftError PRERemoteControl $ RC.rcDecryptBody cmdKN ct
@@ -287,7 +294,7 @@ parseDecryptHTTP2Body rc@RemoteCrypto {sessionCode, signatures, compression} hr
corrIdStr <- liftIO $ getNext 4
ctLenStr <- liftIO $ getNext 4
let ctLen = decodeWord32 ctLenStr
when (ctLen > fromIntegral (maxBound :: Int)) $ throwError RPEInvalidSize
when (ctLen > fromIntegral maxSize) $ throwError RPEInvalidSize
chunks <- liftIO $ getLazy $ fromIntegral ctLen
let hc = CH.hashUpdates (CH.hashInit @SHA512) [corrIdStr, ctLenStr]
hc' = CH.hashUpdates hc chunks
@@ -330,8 +337,5 @@ parseDecryptHTTP2Body rc@RemoteCrypto {sessionCode, signatures, compression} hr
getNext sz = getBuffered bodyBuffer sz Nothing $ getBodyChunk hr
decompress :: LazyByteString -> ExceptT RemoteProtocolError IO ByteString
decompress s
| compression = case Z1.decompress $ LB.toStrict s of
Z1.Error e -> throwError $ RPEInvalidBody e
Z1.Skip -> pure B.empty
Z1.Decompress s' -> pure s'
| compression = liftEitherWith RPEInvalidBody $ limitDecompress' maxSize $ LB.toStrict s
| otherwise = pure $ LB.toStrict s
src/Simplex/Chat/Remote/Types.hs
+3
View File
@@ -18,6 +18,7 @@ import Control.Monad (when)
import qualified Data.Aeson.TH as J
import Data.ByteString (ByteString)
import Data.Int (Int64)
import qualified Data.Map.Strict as M
import Data.Text (Text)
import Data.Word (Word16, Word32)
import Simplex.Chat.Remote.AppVersion
@@ -73,8 +74,10 @@ getRemoteRcvKeys RemoteCrypto {rcvCounter, chainKeys = TSbChainKeys {rcvKey}, sk
| otherwise = do -- prevCorrId < corrId
writeTVar rcvCounter corrId
skipKeys (prevCorrId + 1)
modifyTVar' skippedKeys $ \m -> M.drop (M.size m - maxSkippedKeys) m
Right <$> getKeys
maxSkip = 256
maxSkippedKeys = 1024
getKeys = (,) <$> stateTVar rcvKey C.sbcHkdf <*> stateTVar rcvKey C.sbcHkdf
skipKeys !cId =
when (cId < corrId) $ do
src/Simplex/Chat/Store/Connections.hs
+7 -5
View File
@@ -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_
src/Simplex/Chat/Store/ContactRequest.hs
+11 -9
View File
@@ -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
src/Simplex/Chat/Store/Delivery.hs
+1 -1
View File
@@ -156,7 +156,7 @@ getMsgDeliveryTask_ db taskId =
toTask ((Only taskId') :. jobScopeRow :. (senderGMId, senderMemberId, senderMemberName, brokerTs, Binary msgBody, chatBinding_, sigs_, BI showGroupAsSender)) =
case (toJobScope_ jobScopeRow, J.eitherDecodeStrict' msgBody) of
(Just jobScope, Right chatMsg) ->
let fwdSender = if showGroupAsSender && isNothing chatBinding_ then FwdChannel else FwdMember senderMemberId senderMemberName
let fwdSender = if showGroupAsSender && isNothing chatBinding_ then FwdChannel else FwdMember senderMemberId (fwdMemberName senderMemberName)
-- Re-parsed from msg_body: validates stored content against current code.
-- Signed: original bytes preserved (re-encoding would invalidate signature).
-- Unsigned: re-encoded from parsed ChatMessage on forward (sanitizes content).
src/Simplex/Chat/Store/Direct.hs
+19 -19
View File
@@ -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
@@ -1169,6 +1169,6 @@ getDirectChatTTL db ctId =
getUserContactsToExpire :: DB.Connection -> User -> Int64 -> IO [ContactId]
getUserContactsToExpire db User {userId} globalTTL =
map fromOnly <$> DB.query db ("SELECT contact_id FROM contacts WHERE user_id = ? AND chat_item_ttl > 0" <> cond) (Only userId)
map fromOnly <$> DB.query db ("SELECT contact_id FROM contacts WHERE user_id = ? AND (chat_item_ttl > 0" <> cond <> ")") (Only userId)
where
cond = if globalTTL == 0 then "" else " OR chat_item_ttl IS NULL"
src/Simplex/Chat/Store/Groups.hs
+191 -105
View File
@@ -86,6 +86,7 @@ module Simplex.Chat.Store.Groups
getContactGroupPreferences,
getGroupInvitation,
createNewContactMember,
createNewMemberViaGroup,
createGroupRelayRecord,
getGroupRelayById,
getGroupRelayByGMId,
@@ -140,6 +141,7 @@ module Simplex.Chat.Store.Groups
createBusinessRequestGroup,
getContactViaMember,
getMemberInvitation,
getMemberInvitedVia,
createMemberConnection,
createMemberConnectionAsync,
updatePreparedRelayedGroup,
@@ -193,6 +195,7 @@ module Simplex.Chat.Store.Groups
resetMemberContactFields,
updateMemberProfile,
updateContactMemberProfile,
setMemberBadgeProof,
getXGrpLinkMemReceived,
setXGrpLinkMemReceived,
createNewUnknownGroupMember,
@@ -230,7 +233,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
@@ -454,9 +457,8 @@ createNewGroup db cxt user@User {userId} groupProfile incognitoProfile memberId
}
-- | creates a new group record for the group the current user was invited to, or returns an existing one
createGroupInvitation :: DB.Connection -> StoreCxt -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> C.KeyPairEd25519 -> ExceptT StoreError IO (GroupInfoKeys, GroupMemberId)
createGroupInvitation _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ _ = throwError $ SEContactNotReady localDisplayName
createGroupInvitation db cxt user@User {userId} contact@Contact {contactId, activeConn = Just Connection {peerChatVRange}} GroupInvitation {fromMember, fromMemberKey, invitedMember, connRequest, groupProfile, business} incognitoProfileId memberKeys = do
createGroupInvitation :: DB.Connection -> StoreCxt -> User -> Either Contact GroupMember -> VersionRangeChat -> GroupInvitation -> Maybe ProfileId -> C.KeyPairEd25519 -> ExceptT StoreError IO (GroupInfoKeys, GroupMemberId)
createGroupInvitation db cxt user@User {userId} inviter peerChatVRange GroupInvitation {fromMember, fromMemberKey, invitedMember, connRequest, groupProfile, business} incognitoProfileId memberKeys = do
liftIO getInvitationGroupId_ >>= \case
Nothing -> createGroupInvitation_
Just gId -> do
@@ -500,8 +502,28 @@ createGroupInvitation db cxt user@User {userId} contact@Contact {contactId, acti
((profileId, localDisplayName, connRequest, userId, BI True, currentTs, currentTs, currentTs, currentTs, snd memberKeys) :. businessChatInfoRow business)
insertedRowId db
let hostVRange = adjustedMemberVRange (vr cxt) peerChatVRange
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing ((\(MemberKey k) -> k) <$> fromMemberKey) currentTs hostVRange
membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId (Just $ fst memberKeys) currentTs (vr cxt)
(groupMemberId, invitedBy) <- case inviter of
Left contact@Contact {contactId} -> do
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing ((\(MemberKey k) -> k) <$> fromMemberKey) currentTs hostVRange
pure (groupMemberId, IBContact contactId)
Right GroupMember {memberProfile} -> do
(hostName, memProfileId, hostProfile, badgeVerified) <- createNewMemberProfile_ db cxt user (fromLocalProfile memberProfile) Nothing currentTs
let MemberIdRole {memberId, memberRole} = fromMember
host =
NewGroupMember
{ memInfo = MemberInfo memberId memberRole (Just $ ChatVersionRange hostVRange) hostProfile fromMemberKey,
memCategory = GCHostMember,
memStatus = GSMemInvited,
memRestriction = Nothing,
memInvitedBy = IBUnknown,
memInvitedByGroupMemberId = Nothing,
localDisplayName = hostName,
memContactId = Nothing,
memProfileId
}
GroupMember {groupMemberId} <- createNewMember_ db user groupId host badgeVerified currentTs
pure (groupMemberId, IBUnknown)
membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited invitedBy incognitoProfileId (Just $ fst memberKeys) currentTs (vr cxt)
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
pure
( GroupInfo
@@ -597,7 +619,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 +700,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 +857,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 +908,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 +1435,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
@@ -1433,6 +1457,32 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId,
)
pure indexInGroup
createNewMemberViaGroup :: DB.Connection -> TVar ChaChaDRG -> StoreCxt -> User -> GroupInfo -> GroupMember -> Connection -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createNewMemberViaGroup db gVar cxt user@User {userId} GroupInfo {groupId, membership} viaMember@GroupMember {memberProfile} Connection {connChatVersion, peerChatVRange} memberRole agentConnId connRequest subMode =
createWithRandomId' db gVar $ \memId -> runExceptT $ do
createdAt <- liftIO getCurrentTime
(localDisplayName, memProfileId, profile, badgeVerified) <- createNewMemberProfile_ db cxt user (fromLocalProfile memberProfile) Nothing createdAt
let newMember =
NewGroupMember
{ memInfo = MemberInfo (MemberId memId) memberRole (Just $ ChatVersionRange peerChatVRange) profile Nothing,
memCategory = GCInviteeMember,
memStatus = GSMemInvited,
memRestriction = Nothing,
memInvitedBy = IBUser,
memInvitedByGroupMemberId = Just $ groupMemberId' membership,
localDisplayName,
memContactId = Nothing,
memProfileId
}
member@GroupMember {groupMemberId} <- createNewMember_ db user groupId newMember badgeVerified createdAt
liftIO $ do
DB.execute
db
"UPDATE group_members SET sent_inv_queue_info = ?, invited_via_group_member_id = ? WHERE group_member_id = ?"
(connRequest, groupMemberId' viaMember, groupMemberId)
void $ createMemberConnection_ db userId groupMemberId agentConnId connChatVersion peerChatVRange Nothing 0 createdAt subMode
pure member
createGroupRelayRecord :: DB.Connection -> GroupInfo -> GroupMember -> UserChatRelay -> ExceptT StoreError IO GroupRelay
createGroupRelayRecord db GroupInfo {groupId} GroupMember {groupMemberId} UserChatRelay {chatRelayId} = do
currentTs <- liftIO getCurrentTime
@@ -1713,7 +1763,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 +1802,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 +1875,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 +1934,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 +1944,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 +1977,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 +1997,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 +2073,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 +2119,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 +2127,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 +2136,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 +2144,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 +2155,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
@@ -2230,6 +2286,15 @@ getMemberInvitation db User {userId} groupMemberId =
fmap join . maybeFirstRow fromOnly $
DB.query db "SELECT sent_inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?" (groupMemberId, userId)
getMemberInvitedVia :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> IO (Maybe GroupMember)
getMemberInvitedVia db cxt user@User {userId} GroupInfo {groupId} viaMember = do
currentTs <- getCurrentTime
maybeFirstRow (toContactMember currentTs cxt user) $
DB.query
db
(groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND m.invited_via_group_member_id = ? AND m.member_status NOT IN (?,?,?)")
(userId, groupId, groupMemberId' viaMember, GSMemRejected, GSMemRemoved, GSMemLeft)
createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO Connection
createMemberConnection db userId GroupMember {groupMemberId} agentConnId chatV peerChatVRange subMode = do
currentTs <- getCurrentTime
@@ -2416,13 +2481,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,
@@ -2432,26 +2497,26 @@ createNewGroupMember db cxt user gInfo invitingMember memInfo@MemberInfo {profil
memContactId = Nothing,
memProfileId
}
createNewMember_ db user gInfo newMember badgeVerified currentTs
createNewMember_ db user (groupId' 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_ :: DB.Connection -> User -> GroupId -> NewGroupMember -> Maybe Bool -> UTCTime -> ExceptT StoreError IO GroupMember
createNewMember_
db
User {userId, userContactId}
GroupInfo {groupId}
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 +2532,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 +2551,7 @@ createNewMember_
:. (minV, maxV)
)
groupMemberId <- liftIO $ insertedRowId db
liftIO $ forM_ memberProof $ createMemberBadgeProof db groupMemberId
pure
GroupMember
{ groupMemberId,
@@ -2509,7 +2576,8 @@ createNewMember_
supportChat = Nothing,
memberPubKey,
relayLink = Nothing,
memberVerifiedCode = Nothing
memberVerifiedCode = Nothing,
memberBadgeProof = NoJSON memberProof
}
checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId)
@@ -2614,19 +2682,20 @@ 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}
createNewMember_ db user gInfo newMember badgeVerified currentTs
newMember = NewGroupMember {memInfo = (memInfo :: MemberInfo) {profile = memberProfile'}, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
createNewMember_ db user (groupId' gInfo) newMember badgeVerified currentTs
createIntroReMemberConn :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> MemberInfo -> (CommandId, ConnId) -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createIntroReMemberConn
@@ -2645,42 +2714,12 @@ createIntroReMemberConn
liftIO $ setCommandConnId db user groupCmdId groupConnId
pure (reMember :: GroupMember) {activeConn = Just conn}
createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> VersionRangeChat -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO ()
createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} chatV mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> VersionRangeChat -> (CommandId, ConnId) -> SubscriptionMode -> IO ()
createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId} chatV mcvr (groupCmdId, groupAgentConnId) subMode = do
let cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
currentTs <- getCurrentTime
Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId chatV mcvr viaContactId cLevel currentTs subMode
setCommandConnId db user groupCmdId groupConnId
forM_ directConnIds $ \(directCmdId, directAgentConnId) -> do
Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId ConnNew chatV mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode PQSupportOff
setCommandConnId db user directCmdId directConnId
contactId <- createMemberContact_ directConnId currentTs
updateMember_ contactId currentTs
where
createMemberContact_ :: Int64 -> UTCTime -> IO Int64
createMemberContact_ connId ts = do
DB.execute
db
[sql|
INSERT INTO contacts (contact_profile_id local_display_name, user_id, created_at, updated_at, chat_ts)
SELECT contact_profile_id, ?, ?, ?, ?, ?
FROM group_members
WHERE group_member_id = ?
|]
(localDisplayName, userId, ts, ts, ts, groupMemberId)
contactId <- insertedRowId db
DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, ts, connId)
pure contactId
updateMember_ :: Int64 -> UTCTime -> IO ()
updateMember_ contactId ts =
DB.execute
db
[sql|
UPDATE group_members
SET contact_id = ?, updated_at = ?
WHERE group_member_id = ?
|]
(contactId, ts, groupMemberId)
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection
createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange viaContact connLevel currentTs subMode =
@@ -3105,10 +3144,10 @@ associateContactWithMemberRecord
db
[sql|
UPDATE group_members
SET contact_id = ?, updated_at = ?
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
SET contact_id = ?, local_display_name = ?, contact_profile_id = ?, updated_at = ?
WHERE (user_id = ? AND group_id = ? AND group_member_id = ?) OR contact_id = ?
|]
(contactId, currentTs, userId, groupId, groupMemberId)
(contactId, memLDN, memProfileId, currentTs, userId, groupId, groupMemberId, contactId)
DB.execute
db
[sql|
@@ -3411,16 +3450,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@User {userId} m p' = do
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 presHeader_ p
else liftIO $ setMemberBadgeProof db cxt m presHeader_ p
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}
@@ -3434,16 +3483,17 @@ updateMemberProfile 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)
@@ -3453,6 +3503,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) $
@@ -3470,7 +3551,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,8 +3575,7 @@ createNewUnknownGroupMember db cxt user@User {userId, userContactId} GroupInfo {
createLinkOwnerMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Maybe ContactId -> MemberId -> C.PublicKeyEd25519 -> ExceptT StoreError IO GroupMember
createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupId} contactId_ memberId ownerKey = do
currentTs <- liftIO getCurrentTime
let memberProfile = profileFromName $ nameFromMemberId memberId
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user memberProfile currentTs
(localDisplayName, profileId) <- maybe (newOwnerProfile currentTs) contactNameAndProfile contactId_
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
liftIO $
DB.execute
@@ -3515,13 +3595,19 @@ createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupI
getGroupMemberById db cxt user groupMemberId
where
VersionRange minV maxV = vr cxt
newOwnerProfile currentTs = do
(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
pure (ldn, pId)
-- 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
@@ -3539,9 +3625,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
@@ -3568,9 +3654,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
@@ -3650,7 +3736,7 @@ getGroupChatTTL db gId =
getUserGroupsToExpire :: DB.Connection -> User -> Int64 -> IO [GroupId]
getUserGroupsToExpire db User {userId} globalTTL =
map fromOnly <$> DB.query db ("SELECT group_id FROM groups WHERE user_id = ? AND chat_item_ttl > 0" <> cond) (Only userId)
map fromOnly <$> DB.query db ("SELECT group_id FROM groups WHERE user_id = ? AND (chat_item_ttl > 0" <> cond <> ")") (Only userId)
where
cond = if globalTTL == 0 then "" else " OR chat_item_ttl IS NULL"
src/Simplex/Chat/Store/Postgres/Migrations.hs
+5 -1
View File
@@ -53,6 +53,8 @@ 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.Chat.Store.Postgres.Migrations.M20261010_invite_member_via_group
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Text, Maybe Text)]
@@ -105,7 +107,9 @@ 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),
("20261010_invite_member_via_group", m20261010_invite_member_via_group, Just down_m20261010_invite_member_via_group)
]
-- | The list of migrations in ascending order by date
src/Simplex/Chat/Store/Postgres/Migrations/M20260925_badge_bindings.hs
+37
View File
@@ -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;
|]
src/Simplex/Chat/Store/Postgres/Migrations/M20261010_invite_member_via_group.hs
+21
View File
@@ -0,0 +1,21 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.Postgres.Migrations.M20261010_invite_member_via_group where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20261010_invite_member_via_group :: Text
m20261010_invite_member_via_group =
[r|
ALTER TABLE group_members ADD COLUMN invited_via_group_member_id BIGINT REFERENCES group_members(group_member_id) ON DELETE SET NULL;
CREATE INDEX idx_group_members_invited_via_group_member_id ON group_members(invited_via_group_member_id);
|]
down_m20261010_invite_member_via_group :: Text
down_m20261010_invite_member_via_group =
[r|
DROP INDEX idx_group_members_invited_via_group_member_id;
ALTER TABLE group_members DROP COLUMN invited_via_group_member_id;
|]
src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql
+39 -3
View File
@@ -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,
@@ -1007,7 +1022,8 @@ CREATE TABLE test_chat_schema.group_members (
removed_at timestamp with time zone,
roster_served_version bigint,
member_security_code text,
member_security_code_verified_at timestamp with time zone
member_security_code_verified_at timestamp with time zone,
invited_via_group_member_id bigint
);
@@ -1170,7 +1186,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 +1955,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);
@@ -2688,6 +2710,10 @@ CREATE INDEX idx_group_members_invited_by_group_member_id ON test_chat_schema.gr
CREATE INDEX idx_group_members_invited_via_group_member_id ON test_chat_schema.group_members USING btree (invited_via_group_member_id);
CREATE INDEX idx_group_members_member_profile_id ON test_chat_schema.group_members USING btree (member_profile_id);
@@ -3404,6 +3430,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;
@@ -3439,6 +3470,11 @@ ALTER TABLE ONLY test_chat_schema.group_members
ALTER TABLE ONLY test_chat_schema.group_members
ADD CONSTRAINT group_members_invited_via_group_member_id_fkey FOREIGN KEY (invited_via_group_member_id) REFERENCES test_chat_schema.group_members(group_member_id) ON DELETE SET NULL;
ALTER TABLE ONLY test_chat_schema.group_members
ADD CONSTRAINT group_members_member_profile_id_fkey FOREIGN KEY (member_profile_id) REFERENCES test_chat_schema.contact_profiles(contact_profile_id) ON DELETE SET NULL;
src/Simplex/Chat/Store/Profiles.hs
+40 -18
View File
@@ -44,6 +44,7 @@ module Simplex.Chat.Store.Profiles
updateUserAutoAcceptMemberContacts,
updateUserAutoAcceptGroupInvitations,
updateUserProfile,
updatedUserProfile,
setUserBadge,
setUserProfileContactLink,
getUserContactProfiles,
@@ -77,6 +78,7 @@ module Simplex.Chat.Store.Profiles
createCall,
deleteCalls,
getCalls,
expireCalls,
createCommand,
setCommandConnId,
deleteCommand,
@@ -103,6 +105,7 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Simplex.Chat.Badges (LocalBadge, localBadgeToRow)
import Simplex.Chat.Call
import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Operators
import Simplex.Chat.Protocol
import Simplex.Chat.Store.Direct
@@ -126,7 +129,7 @@ import Simplex.Messaging.Agent.Store.Entity
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple (In (..), Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..), Query, (:.) (..))
@@ -167,7 +170,7 @@ createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {di
(profileId, displayName, userId, BI True, currentTs, currentTs, currentTs)
contactId <- insertedRowId db
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
pure $ toUser currentTs $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, description, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, BI autoAcceptGroupInvitations, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing) :. localBadgeToRow Nothing :. (Nothing, Nothing, Nothing)
pure $ toUser currentTs $ (userId, auId, contactId, profileId, BI activeUser, order, displayName) :. (displayName, fullName, shortDescr, description, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, BI autoAcceptGroupInvitations, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing) :. localBadgeToRow Nothing :. (Nothing, Nothing, Nothing)
-- TODO [mentions]
getUsersInfo :: DB.Connection -> IO [UserInfo]
@@ -342,21 +345,15 @@ updateUserProfile db user p'
currentTs <- getCurrentTime
updateUserProfileFields_' db userId profileId p' currentTs
userMemberProfileUpdatedAt' <- updateUserMemberProfileUpdatedAt_ currentTs
pure user {profile = (toLocalProfile profileId p' localAlias currentTs (Just False) Nothing) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
pure user {profile = updatedUserProfile user p' currentTs, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
| otherwise =
checkConstraint SEDuplicateName . liftIO $ do
checkConstraint SEDuplicateName . ExceptT . withLocalDisplayName db userId newName $ \newLDN -> do
currentTs <- getCurrentTime
-- Insert first: checkConstraint returns the violation as a value, so the
-- transaction commits, keeping whatever ran before the failing insert.
DB.execute
db
"INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
(newName, newName, userId, currentTs, currentTs)
DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newName, currentTs, userId)
DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newLDN, currentTs, userId)
userMemberProfileUpdatedAt' <- updateUserMemberProfileUpdatedAt_ currentTs
updateUserProfileFields_' db userId profileId p' currentTs
updateContactLDN_ db user userContactId localDisplayName newName currentTs
pure user {localDisplayName = newName, profile = (toLocalProfile profileId p' localAlias currentTs (Just False) Nothing) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
updateContactLDN_ db user userContactId localDisplayName newLDN currentTs
pure $ Right user {localDisplayName = newLDN, profile = updatedUserProfile user p' currentTs, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
where
updateUserMemberProfileUpdatedAt_ currentTs
| userMemberProfileChanged = do
@@ -364,10 +361,14 @@ updateUserProfile db user p'
pure $ Just currentTs
| otherwise = pure userMemberProfileUpdatedAt
userMemberProfileChanged = newName /= displayName || fn' /= fullName || d' /= shortDescr || desc' /= description || img' /= image
User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, shortDescr, description, image, localBadge, localAlias}, userMemberProfileUpdatedAt} = user
User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, shortDescr, description, image}, userMemberProfileUpdatedAt} = user
Profile {displayName = newName, fullName = fn', shortDescr = d', description = desc', image = img', preferences} = p'
fullPreferences = fullPreferences' preferences
updatedUserProfile :: User -> Profile -> UTCTime -> LocalProfile
updatedUserProfile User {profile = LocalProfile {profileId, localBadge, localAlias}} p' ts =
(toLocalProfile profileId p' localAlias ts (Just False) Nothing) {localBadge}
-- own profile field update; leaves the badge columns alone (the credential is owned by setUserBadge/addUserBadge)
updateUserProfileFields_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
updateUserProfileFields_' db userId profileId Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences, peerType} updatedAt =
@@ -409,19 +410,20 @@ setUserSimplexDomain db user@User {userId, profile = p@LocalProfile {profileId}}
pure (user :: User) {profile = p {contactDomain = mkDomainClaim <$> domain_}}
setUserProfileContactLink :: DB.Connection -> User -> Maybe UserContactLink -> IO User
setUserProfileContactLink db user@User {userId, profile = p@LocalProfile {profileId}} ucl_ = do
setUserProfileContactLink db user@User {userId, profile = p@LocalProfile {profileId, contactDomain}} ucl_ = do
ts <- getCurrentTime
DB.execute
db
[sql|
UPDATE contact_profiles
SET contact_link = ?, updated_at = ?
SET contact_link = ?, contact_domain = ?, updated_at = ?
WHERE user_id = ? AND contact_profile_id = ?
|]
(contactLink, ts, userId, profileId)
pure (user :: User) {profile = p {contactLink}}
(contactLink, claimDomain <$> contactDomain', ts, userId, profileId)
pure (user :: User) {profile = p {contactLink, contactDomain = contactDomain'}}
where
contactLink = profileContactLink <$> ucl_
contactDomain' = if isJust contactLink then contactDomain else Nothing
-- only used in tests
getUserContactProfiles :: DB.Connection -> User -> IO [Profile]
@@ -1084,6 +1086,26 @@ getCalls db =
toCall :: (ContactId, CallId, Text, ChatItemId, CallState, UTCTime) -> Call
toCall (contactId, callId, callUUID, chatItemId, callState, callTs) = Call {contactId, callId, callUUID, chatItemId, callState, callTs}
-- only received call invitations are stored, so their chat items are pending and become missed
expireCalls :: DB.Connection -> UTCTime -> IO ()
expireCalls db cutoffTs = do
itemIds :: [ChatItemId] <- map fromOnly <$> DB.query db "DELETE FROM calls WHERE call_ts < ? RETURNING chat_item_id" (Only cutoffTs)
currentTs <- getCurrentTime
let content = CIRcvCall CISCallMissed 0
contentText = ciContentToText content
unless (null itemIds) $
#if defined(dbPostgres)
DB.execute
db
"UPDATE chat_items SET item_content = ?, item_text = ?, updated_at = ? WHERE chat_item_id IN ?"
(content, contentText, currentTs, In itemIds)
#else
DB.executeMany
db
"UPDATE chat_items SET item_content = ?, item_text = ?, updated_at = ? WHERE chat_item_id = ?"
(map (content,contentText,currentTs,) itemIds)
#endif
createCommand :: DB.Connection -> User -> Maybe Int64 -> CommandFunction -> IO CommandId
createCommand db User {userId} connId commandFunction = do
currentTs <- getCurrentTime
src/Simplex/Chat/Store/RelayRequests.hs
+4 -4
View File
@@ -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 ()
src/Simplex/Chat/Store/SQLite/Migrations.hs
+5 -1
View File
@@ -176,6 +176,8 @@ 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.Chat.Store.SQLite.Migrations.M20261010_invite_member_via_group
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -351,7 +353,9 @@ 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),
("20261010_invite_member_via_group", m20261010_invite_member_via_group, Just down_m20261010_invite_member_via_group)
]
-- | The list of migrations in ascending order by date
src/Simplex/Chat/Store/SQLite/Migrations/M20260925_badge_bindings.hs
+36
View File
@@ -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;
|]
src/Simplex/Chat/Store/SQLite/Migrations/M20261010_invite_member_via_group.hs
+20
View File
@@ -0,0 +1,20 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20261010_invite_member_via_group where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20261010_invite_member_via_group :: Query
m20261010_invite_member_via_group =
[sql|
ALTER TABLE group_members ADD COLUMN invited_via_group_member_id INTEGER REFERENCES group_members(group_member_id) ON DELETE SET NULL;
CREATE INDEX idx_group_members_invited_via_group_member_id ON group_members(invited_via_group_member_id);
|]
down_m20261010_invite_member_via_group :: Query
down_m20261010_invite_member_via_group =
[sql|
DROP INDEX idx_group_members_invited_via_group_member_id;
ALTER TABLE group_members DROP COLUMN invited_via_group_member_id;
|]
src/Simplex/Chat/Store/SQLite/Migrations/agent_query_plans.txt
+195 -10
View File
@@ -144,7 +144,7 @@ SEARCH r USING INDEX idx_rcv_file_chunk_replicas_rcv_file_chunk_id (rcv_file_chu
SEARCH s USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT c.corr_id, cs.user_id, c.command
SELECT c.corr_id, cs.user_id, c.command, c.created_at
FROM commands c
JOIN connections cs USING (conn_id)
WHERE c.command_id = ?
@@ -249,6 +249,26 @@ Plan:
SEARCH snd_files USING INDEX idx_snd_files_status_created_at (status=? AND created_at>?)
USE TEMP B-TREE FOR ORDER BY
Query:
SELECT DISTINCT
s.xftp_host, s.xftp_port, s.xftp_key_hash
FROM rcv_file_chunk_replicas r
JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
JOIN rcv_file_chunks c ON c.rcv_file_chunk_id = r.rcv_file_chunk_id
JOIN rcv_files f ON f.rcv_file_id = c.rcv_file_id
WHERE (f.rcv_file_id = ? OR f.redirect_id = ?) AND r.replica_number = 1
Plan:
MULTI-INDEX OR
INDEX 1
SEARCH f USING INTEGER PRIMARY KEY (rowid=?)
INDEX 2
SEARCH f USING COVERING INDEX idx_rcv_files_redirect_id (redirect_id=?)
SEARCH c USING COVERING INDEX idx_rcv_file_chunks_rcv_file_id (rcv_file_id=?)
SEARCH r USING INDEX idx_rcv_file_chunk_replicas_rcv_file_chunk_id (rcv_file_chunk_id=?)
SEARCH s USING INTEGER PRIMARY KEY (rowid=?)
USE TEMP B-TREE FOR DISTINCT
Query:
SELECT MAX(internal_id)
FROM messages
@@ -273,6 +293,16 @@ Query:
Plan:
SEARCH connections USING PRIMARY KEY (conn_id=?)
Query:
SELECT user_id FROM users u
WHERE u.deleted = ?
AND NOT EXISTS (SELECT c.conn_id FROM connections c WHERE c.user_id = u.user_id)
Plan:
SCAN u
CORRELATED SCALAR SUBQUERY 1
SEARCH c USING COVERING INDEX idx_connections_user (user_id=?)
Query:
SELECT user_id FROM users u
WHERE u.user_id = ?
@@ -495,6 +525,23 @@ Query:
Plan:
SEARCH conn_confirmations USING INDEX idx_conn_confirmations_conn_id (conn_id=?)
Query:
SELECT conn_id, (
SELECT processed_ratchet_key_hash_id
FROM processed_ratchet_key_hashes
WHERE conn_id = c.conn_id
ORDER BY processed_ratchet_key_hash_id DESC
LIMIT 1 OFFSET ?
) AS max_excess_id
FROM processed_ratchet_key_hashes c
GROUP BY conn_id
HAVING COUNT(*) > ?
Plan:
SCAN c USING COVERING INDEX idx_processed_ratchet_key_hashes_conn_id
CORRELATED SCALAR SUBQUERY 1
SEARCH processed_ratchet_key_hashes USING COVERING INDEX idx_processed_ratchet_key_hashes_conn_id (conn_id=?)
Query:
SELECT conn_id, ratchet_state, sender_key, e2e_snd_pub_key, sender_conn_info, smp_reply_queues, smp_client_version
FROM conn_confirmations
@@ -567,6 +614,15 @@ Query:
Plan:
SEARCH address_ratchet_keys USING INDEX idx_address_ratchet_keys (conn_id=? AND ratchet_key_id=?)
Query:
UPDATE rcv_messages
SET receive_attempts = receive_attempts + 1
WHERE conn_id = ? AND internal_id = ?
RETURNING receive_attempts
Plan:
SEARCH rcv_messages USING COVERING INDEX idx_rcv_messages_conn_id_internal_id (conn_id=? AND internal_id=?)
Query:
DELETE FROM address_ratchet_keys
WHERE conn_id = ?
@@ -591,6 +647,39 @@ Query:
Plan:
SEARCH conn_confirmations USING COVERING INDEX idx_conn_confirmations_conn_id (conn_id=?)
Query:
DELETE FROM encrypted_rcv_message_hashes
WHERE encrypted_rcv_message_hash_id IN (
SELECT encrypted_rcv_message_hash_id
FROM encrypted_rcv_message_hashes
WHERE created_at < ?
ORDER BY created_at ASC
LIMIT ?
)
Plan:
SEARCH encrypted_rcv_message_hashes USING INTEGER PRIMARY KEY (rowid=?)
LIST SUBQUERY 1
SEARCH encrypted_rcv_message_hashes USING COVERING INDEX idx_encrypted_rcv_message_hashes_created_at (created_at<?)
Query:
DELETE FROM messages
WHERE (conn_id, internal_id) IN (
SELECT conn_id, internal_id
FROM messages
WHERE internal_ts < ? AND internal_snd_id IS NOT NULL
ORDER BY internal_ts ASC
LIMIT ?
)
Plan:
SEARCH messages USING COVERING INDEX idx_messages_conn_id (conn_id=? AND internal_id=?)
LIST SUBQUERY 1
SEARCH messages USING INDEX idx_messages_internal_ts (internal_ts<?)
SEARCH snd_message_deliveries USING COVERING INDEX idx_snd_message_deliveries_conn_id_internal_id (conn_id=? AND internal_id=?)
SEARCH snd_messages USING COVERING INDEX idx_snd_messages_conn_id_internal_id (conn_id=? AND internal_id=?)
SEARCH rcv_messages USING COVERING INDEX idx_rcv_messages_conn_id_internal_id (conn_id=? AND internal_id=?)
Query:
INSERT INTO address_ratchet_keys
(conn_id, ratchet_key_id, x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem)
@@ -736,6 +825,30 @@ Query:
Plan:
Query:
SELECT rcv_file_id, rcv_file_entity_id, prefix_path
FROM rcv_files
WHERE created_at < ?
Plan:
SCAN rcv_files
Query:
SELECT rcv_file_id, rcv_file_entity_id, prefix_path
FROM rcv_files
WHERE deleted = 1
Plan:
SCAN rcv_files
Query:
SELECT rcv_file_id, rcv_file_entity_id, tmp_path
FROM rcv_files
WHERE status IN (?,?) AND tmp_path IS NOT NULL
Plan:
SEARCH rcv_files USING INDEX idx_rcv_files_status_created_at (status=?)
Query:
SELECT rcv_replica_id, rcv_replica_key
FROM snd_file_chunk_replica_recipients
@@ -744,6 +857,30 @@ Query:
Plan:
SEARCH snd_file_chunk_replica_recipients USING INDEX idx_snd_file_chunk_replica_recipients_snd_file_chunk_replica_id (snd_file_chunk_replica_id=?)
Query:
SELECT snd_file_id, snd_file_entity_id, prefix_path
FROM snd_files
WHERE created_at < ?
Plan:
SCAN snd_files
Query:
SELECT snd_file_id, snd_file_entity_id, prefix_path
FROM snd_files
WHERE deleted = 1
Plan:
SCAN snd_files
Query:
SELECT snd_file_id, snd_file_entity_id, prefix_path
FROM snd_files
WHERE status IN (?,?) AND prefix_path IS NOT NULL
Plan:
SEARCH snd_files USING INDEX idx_snd_files_status_created_at (status=?)
Query:
UPDATE client_services
SET service_id = ?
@@ -1001,7 +1138,7 @@ SEARCH s USING PRIMARY KEY (host=? AND port=?)
SEARCH c USING PRIMARY KEY (conn_id=?)
Query:
SELECT c.user_id, q.conn_id, q.host, q.port, COALESCE(q.server_key_hash, s.key_hash), q.rcv_id, q.rcv_private_key, q.status, c.enable_ntfs, q.client_notice_id,
SELECT c.user_id, q.conn_id, q.rcv_id, q.rcv_private_key, q.status, c.enable_ntfs, q.client_notice_id,
q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id
FROM rcv_queues q
JOIN servers s ON q.host = s.host AND q.port = s.port
@@ -1013,7 +1150,7 @@ SEARCH q USING PRIMARY KEY (host=? AND port=?)
SEARCH c USING PRIMARY KEY (conn_id=?)
Query:
SELECT c.user_id, q.conn_id, q.host, q.port, COALESCE(q.server_key_hash, s.key_hash), q.rcv_id, q.rcv_private_key, q.status, c.enable_ntfs, q.client_notice_id,
SELECT c.user_id, q.conn_id, q.rcv_id, q.rcv_private_key, q.status, c.enable_ntfs, q.client_notice_id,
q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id
FROM rcv_queues q
JOIN servers s ON q.host = s.host AND q.port = s.port
@@ -1025,7 +1162,7 @@ SEARCH q USING PRIMARY KEY (host=? AND port=?)
SEARCH c USING PRIMARY KEY (conn_id=?)
Query:
SELECT c.user_id, q.conn_id, q.host, q.port, COALESCE(q.server_key_hash, s.key_hash), q.rcv_id, q.rcv_private_key, q.status, c.enable_ntfs, q.client_notice_id,
SELECT c.user_id, q.conn_id, q.rcv_id, q.rcv_private_key, q.status, c.enable_ntfs, q.client_notice_id,
q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id
FROM rcv_queues q
JOIN servers s ON q.host = s.host AND q.port = s.port
@@ -1048,11 +1185,15 @@ Query: DELETE FROM conn_invitations WHERE invitation_id = ?
Plan:
SEARCH conn_invitations USING PRIMARY KEY (invitation_id=?)
Query: DELETE FROM conn_invitations WHERE service_request = 1 AND created_at < ?
Plan:
SCAN conn_invitations
Query: DELETE FROM connections WHERE conn_id = ?
Plan:
SEARCH connections USING PRIMARY KEY (conn_id=?)
SEARCH address_ratchet_keys USING COVERING INDEX idx_address_ratchet_keys (conn_id=?)
SEARCH processed_ratchet_key_hashes USING COVERING INDEX idx_processed_ratchet_key_hashes_hash (conn_id=?)
SEARCH processed_ratchet_key_hashes USING COVERING INDEX idx_processed_ratchet_key_hashes_conn_id (conn_id=?)
SEARCH encrypted_rcv_message_hashes USING COVERING INDEX idx_encrypted_rcv_message_hashes_hash (conn_id=?)
SEARCH snd_message_deliveries USING COVERING INDEX idx_snd_message_deliveries_conn_id_internal_id (conn_id=?)
SEARCH commands USING COVERING INDEX idx_commands_conn_id (conn_id=?)
@@ -1067,7 +1208,7 @@ Query: DELETE FROM connections WHERE user_id = 2
Plan:
SEARCH connections USING COVERING INDEX idx_connections_user (user_id=?)
SEARCH address_ratchet_keys USING COVERING INDEX idx_address_ratchet_keys (conn_id=?)
SEARCH processed_ratchet_key_hashes USING COVERING INDEX idx_processed_ratchet_key_hashes_hash (conn_id=?)
SEARCH processed_ratchet_key_hashes USING COVERING INDEX idx_processed_ratchet_key_hashes_conn_id (conn_id=?)
SEARCH encrypted_rcv_message_hashes USING COVERING INDEX idx_encrypted_rcv_message_hashes_hash (conn_id=?)
SEARCH snd_message_deliveries USING COVERING INDEX idx_snd_message_deliveries_conn_id_internal_id (conn_id=?)
SEARCH commands USING COVERING INDEX idx_commands_conn_id (conn_id=?)
@@ -1078,6 +1219,10 @@ SEARCH messages USING COVERING INDEX idx_messages_conn_id (conn_id=?)
SEARCH snd_queues USING COVERING INDEX idx_snd_queue_id (conn_id=?)
SEARCH rcv_queues USING COVERING INDEX idx_rcv_queue_id (conn_id=?)
Query: DELETE FROM deleted_snd_chunk_replicas WHERE created_at < ?
Plan:
SEARCH deleted_snd_chunk_replicas USING COVERING INDEX idx_deleted_snd_chunk_replicas_pending (created_at<?)
Query: DELETE FROM deleted_snd_chunk_replicas WHERE deleted_snd_chunk_replica_id = ?
Plan:
SEARCH deleted_snd_chunk_replicas USING INTEGER PRIMARY KEY (rowid=?)
@@ -1097,6 +1242,14 @@ Query: DELETE FROM ntf_subscriptions WHERE conn_id = ?
Plan:
SEARCH ntf_subscriptions USING PRIMARY KEY (conn_id=?)
Query: DELETE FROM ntf_tokens_to_delete WHERE created_at < ?
Plan:
SCAN ntf_tokens_to_delete
Query: DELETE FROM processed_ratchet_key_hashes WHERE conn_id = ? AND processed_ratchet_key_hash_id <= ? AND created_at < ?
Plan:
SEARCH processed_ratchet_key_hashes USING INDEX idx_processed_ratchet_key_hashes_conn_id (conn_id=? AND processed_ratchet_key_hash_id<?)
Query: DELETE FROM ratchets WHERE conn_id = ?
Plan:
SEARCH ratchets USING PRIMARY KEY (conn_id=?)
@@ -1222,14 +1375,34 @@ Query: SELECT conn_id FROM connections WHERE deleted = 0
Plan:
SEARCH connections USING COVERING INDEX idx_connections_deleted (deleted=?)
Query: SELECT conn_id FROM connections WHERE deleted = ?
Plan:
SEARCH connections USING COVERING INDEX idx_connections_deleted (deleted=?)
Query: SELECT conn_id FROM connections WHERE deleted_at_wait_delivery IS NOT NULL
Plan:
SCAN connections
Query: SELECT conn_id FROM connections WHERE service_request_expires_at < ? AND deleted = 0 AND deleted_at_wait_delivery IS NULL
Plan:
SEARCH connections USING INDEX idx_connections_deleted (deleted=?)
Query: SELECT conn_id FROM connections WHERE user_id = ?
Plan:
SEARCH connections USING COVERING INDEX idx_connections_user (user_id=?)
Query: SELECT conn_id FROM rcv_queues WHERE switch_status = ? AND deleted = 0
Plan:
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:
SEARCH ratchets USING PRIMARY KEY (conn_id=?)
Query: SELECT count(1) FROM commands
Plan:
SCAN commands USING COVERING INDEX idx_commands_conn_id
Query: SELECT count(1) FROM connections
Plan:
SCAN connections USING COVERING INDEX idx_connections_deleted
@@ -1250,10 +1423,6 @@ Query: SELECT deleted FROM snd_files WHERE snd_file_id = ?
Plan:
SEARCH snd_files USING INTEGER PRIMARY KEY (rowid=?)
Query: SELECT header_key, msg_n, msg_key FROM skipped_messages WHERE conn_id = ?
Plan:
SEARCH skipped_messages USING INDEX idx_skipped_messages_conn_id (conn_id=?)
Query: SELECT key_hash FROM servers WHERE host = ? AND port = ?
Plan:
SEARCH servers USING PRIMARY KEY (host=? AND port=?)
@@ -1270,6 +1439,10 @@ Query: SELECT ratchet_state, x3dh_pub_key_1, x3dh_pub_key_2, pq_pub_kem FROM rat
Plan:
SEARCH ratchets USING PRIMARY KEY (conn_id=?)
Query: SELECT ratchet_sync_state FROM connections WHERE conn_id = ?
Plan:
SEARCH connections USING PRIMARY KEY (conn_id=?)
Query: SELECT rcv_file_id FROM rcv_files WHERE rcv_file_entity_id = ?
Plan:
SEARCH rcv_files USING COVERING INDEX sqlite_autoindex_rcv_files_1 (rcv_file_entity_id=?)
@@ -1290,6 +1463,10 @@ Query: SELECT rcv_queue_id, broker_id FROM rcv_messages WHERE conn_id = ? AND in
Plan:
SEARCH rcv_messages USING PRIMARY KEY (conn_id=?)
Query: SELECT skipped_message_id, header_key, msg_n, msg_key FROM skipped_messages WHERE conn_id = ? ORDER BY skipped_message_id DESC LIMIT ?
Plan:
SEARCH skipped_messages USING INDEX idx_skipped_messages_conn_id (conn_id=?)
Query: SELECT snd_file_id FROM snd_files WHERE snd_file_entity_id = ?
Plan:
SEARCH snd_files USING COVERING INDEX idx_snd_files_snd_file_entity_id (snd_file_entity_id=?)
@@ -1374,6 +1551,10 @@ Query: UPDATE rcv_files SET key = ?, nonce = ?, chunk_size = ?, updated_at = ? W
Plan:
SEARCH rcv_files USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE rcv_files SET status = ?, updated_at = ? WHERE (rcv_file_id = ? OR redirect_id = ?) AND status = ?
Plan:
SEARCH rcv_files USING INDEX idx_rcv_files_status_created_at (status=?)
Query: UPDATE rcv_files SET status = ?, updated_at = ? WHERE rcv_file_id = ?
Plan:
SEARCH rcv_files USING INTEGER PRIMARY KEY (rowid=?)
@@ -1430,6 +1611,10 @@ Query: UPDATE snd_files SET status = ?, updated_at = ? WHERE snd_file_id = ?
Plan:
SEARCH snd_files USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE snd_files SET status = ?, updated_at = ? WHERE snd_file_id = ? AND status = ?
Plan:
SEARCH snd_files USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE snd_messages SET rcpt_internal_id = ?, rcpt_status = ? WHERE conn_id = ? AND internal_snd_id = ?
Plan:
SEARCH snd_messages USING PRIMARY KEY (conn_id=? AND internal_snd_id=?)
src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
+253 -51
View File
@@ -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=?)
@@ -54,6 +55,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -84,6 +86,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=?)
@@ -108,6 +111,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -169,13 +173,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 +192,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 +299,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=?)
@@ -316,6 +324,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -328,6 +337,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=?)
@@ -352,6 +362,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -364,6 +375,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=?)
@@ -388,6 +400,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -584,10 +597,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=?)
@@ -612,6 +626,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -623,6 +638,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=?)
@@ -647,6 +663,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -659,6 +676,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=?)
@@ -683,6 +701,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -695,6 +714,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=?)
@@ -719,6 +739,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -762,7 +783,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
@@ -1123,6 +1144,15 @@ SEARCH m USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
SEARCH g USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
SEARCH h USING INDEX idx_sent_probe_hashes_sent_probe_id (sent_probe_id=?)
Query:
SELECT s.member_relations_vector, r.index_in_group
FROM group_members s, group_members r
WHERE s.local_display_name = ? AND r.local_display_name = ?
Plan:
SCAN s
SEARCH r USING AUTOMATIC PARTIAL COVERING INDEX (local_display_name=?)
Query:
SELECT t.roster_transfer_id, t.roster_version, t.roster_digest, t.sending_owner_gm_id, t.broker_ts,
t.roster_msg_chat_binding, t.roster_msg_signatures, t.roster_msg_body
@@ -1258,6 +1288,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=?)
@@ -1282,6 +1313,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -1295,6 +1327,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=?)
@@ -1319,6 +1352,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -1835,11 +1869,15 @@ SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE group_members
SET contact_id = ?, updated_at = ?
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
SET contact_id = ?, local_display_name = ?, contact_profile_id = ?, updated_at = ?
WHERE (user_id = ? AND group_id = ? AND group_member_id = ?) OR contact_id = ?
Plan:
MULTI-INDEX OR
INDEX 1
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
INDEX 2
SEARCH group_members USING INDEX idx_group_members_contact_id (contact_id=?)
Query:
UPDATE group_members
@@ -1884,6 +1922,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 = ?,
@@ -1944,6 +1983,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=?)
@@ -1968,6 +2008,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -1980,6 +2021,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=?)
@@ -2004,6 +2046,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -4197,15 +4240,6 @@ SEARCH c USING INTEGER PRIMARY KEY (rowid=?)
SEARCH cs USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
SEARCH m USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
Query:
SELECT s.member_relations_vector, r.index_in_group
FROM group_members s, group_members r
WHERE s.local_display_name = ? AND r.local_display_name = ?
Plan:
SCAN s
SEARCH r USING AUTOMATIC PARTIAL COVERING INDEX (local_display_name=?)
Query:
SELECT smp_server_id, host, port, key_hash, basic_auth, preset, tested, enabled,
role_storage, role_proxy, role_names
@@ -5006,10 +5040,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:
@@ -5064,6 +5098,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)
@@ -5340,7 +5388,7 @@ SEARCH connections_sync USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE contact_profiles
SET contact_link = ?, updated_at = ?
SET contact_link = ?, contact_domain = ?, updated_at = ?
WHERE user_id = ? AND contact_profile_id = ?
Plan:
@@ -5828,11 +5876,11 @@ Query:
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ?
WHERE g.group_id = ? AND g.user_id = ? AND mu.user_id = ? AND mu.contact_id = ?
Plan:
SEARCH g USING INTEGER PRIMARY KEY (rowid=?)
SEARCH gp USING INTEGER PRIMARY KEY (rowid=?)
SEARCH mu USING INDEX idx_group_members_contact_id (contact_id=?)
SEARCH mu USING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
SEARCH pu USING INTEGER PRIMARY KEY (rowid=?)
Query:
@@ -5879,10 +5927,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 (?, ?, ?, ?)
@@ -5896,6 +5946,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
@@ -5907,16 +5958,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
@@ -5928,15 +5982,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
@@ -5948,15 +6005,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
@@ -5968,15 +6028,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
@@ -5988,15 +6051,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
@@ -6008,15 +6074,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
@@ -6028,15 +6097,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
@@ -6048,15 +6120,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
@@ -6068,15 +6143,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
@@ -6088,15 +6166,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
@@ -6108,15 +6189,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
@@ -6128,15 +6212,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
@@ -6148,15 +6235,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
@@ -6168,15 +6258,41 @@ 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.invited_via_group_member_id = ? AND m.member_status NOT IN (?,?,?)
Plan:
SEARCH m USING INDEX idx_group_members_invited_via_group_member_id (invited_via_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
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.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,
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,
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
@@ -6361,7 +6477,7 @@ Plan:
SEARCH server_operators USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
FROM users u
@@ -6374,7 +6490,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
FROM users u
@@ -6388,7 +6504,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
FROM users u
@@ -6402,7 +6518,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
FROM users u
@@ -6417,7 +6533,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
FROM users u
@@ -6431,7 +6547,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
FROM users u
@@ -6445,7 +6561,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
FROM users u
@@ -6459,7 +6575,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
FROM users u
@@ -6473,7 +6589,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
FROM users u
@@ -6486,7 +6602,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
FROM users u
@@ -6647,6 +6763,10 @@ Error: SQLite3 returned ErrorError while attempting to perform prepare "explain
Query: DELETE FROM app_settings
Plan:
Query: DELETE FROM calls WHERE call_ts < ? RETURNING chat_item_id
Plan:
SCAN calls
Query: DELETE FROM calls WHERE user_id = ? AND contact_id = ?
Plan:
SEARCH calls USING INDEX idx_calls_contact_id (contact_id=?)
@@ -6890,9 +7010,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=?)
@@ -6917,6 +7042,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -6924,6 +7050,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=?)
@@ -6948,6 +7075,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -6955,6 +7083,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=?)
@@ -6979,6 +7108,7 @@ SEARCH rcv_files USING COVERING INDEX idx_rcv_files_group_member_id (group_membe
SEARCH snd_files USING COVERING INDEX idx_snd_files_group_member_id (group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
SEARCH group_member_intros USING COVERING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id (invited_via_group_member_id=?)
SEARCH group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id (invited_by_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_grp_direct_inv_from_group_member_id (grp_direct_inv_from_group_member_id=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (contact_group_member_id=?)
@@ -7278,6 +7408,10 @@ Query: SELECT COUNT(1) FROM chat_items WHERE user_id = ? AND group_id = ? AND ms
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id=? AND msg_content_tag=? AND item_deleted=? AND item_sent=?)
Query: SELECT COUNT(1) FROM commands WHERE command_function = 'set_short_link'
Plan:
SCAN commands
Query: SELECT COUNT(1) FROM contacts WHERE user_id = ? AND chat_item_ttl > 0
Plan:
SEARCH contacts USING INDEX idx_contacts_chat_ts (user_id=?)
@@ -7333,6 +7467,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=?)
@@ -7378,6 +7516,10 @@ Query: SELECT chat_item_id FROM chat_items WHERE group_scope_tag = 'member_suppo
Plan:
SCAN chat_items
Query: SELECT chat_item_id FROM chat_items WHERE item_sent = 0 AND item_text LIKE ? || '%'
Plan:
SCAN chat_items
Query: SELECT chat_item_id FROM chat_items WHERE item_text LIKE '%' || ? || '%' ORDER BY chat_item_id DESC LIMIT 1
Plan:
SCAN chat_items
@@ -7454,9 +7596,9 @@ Query: SELECT connection_id FROM connections WHERE user_id = ? AND group_member_
Plan:
SEARCH connections USING INDEX idx_connections_group_member_id (group_member_id=?)
Query: SELECT contact_id FROM contacts WHERE user_id = ? AND chat_item_ttl > 0 OR chat_item_ttl IS NULL
Query: SELECT contact_id FROM contacts WHERE user_id = ? AND (chat_item_ttl > 0 OR chat_item_ttl IS NULL)
Plan:
SCAN contacts
SEARCH contacts USING INDEX idx_contacts_chat_ts (user_id=?)
Query: SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 0
Plan:
@@ -7486,6 +7628,10 @@ Query: SELECT contact_request_id FROM contact_requests WHERE user_id = ? AND loc
Plan:
SEARCH contact_requests USING COVERING INDEX sqlite_autoindex_contact_requests_1 (user_id=? AND local_display_name=?)
Query: SELECT count(1) FROM calls
Plan:
SCAN calls USING COVERING INDEX idx_calls_contact_id
Query: SELECT count(1) FROM chat_items WHERE chat_item_id > ?
Plan:
SEARCH chat_items USING INTEGER PRIMARY KEY (rowid>?)
@@ -7496,7 +7642,7 @@ SCAN files
Query: SELECT count(1) FROM group_members
Plan:
SCAN group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id
SCAN group_members USING COVERING INDEX idx_group_members_invited_via_group_member_id
Query: SELECT count(1) FROM pending_group_messages
Plan:
@@ -7548,9 +7694,9 @@ Query: SELECT group_id FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMI
Plan:
SEARCH groups USING INDEX sqlite_autoindex_groups_2 (user_id=?)
Query: SELECT group_id FROM groups WHERE user_id = ? AND chat_item_ttl > 0 OR chat_item_ttl IS NULL
Query: SELECT group_id FROM groups WHERE user_id = ? AND (chat_item_ttl > 0 OR chat_item_ttl IS NULL)
Plan:
SCAN groups
SEARCH groups USING INDEX sqlite_autoindex_groups_2 (user_id=?)
Query: SELECT group_id FROM groups WHERE user_id = ? AND creating_in_progress = 1 AND created_at <= ?
Plan:
@@ -7588,10 +7734,18 @@ Query: SELECT image FROM contact_profiles WHERE display_name = ? LIMIT 1
Plan:
SEARCH contact_profiles USING INDEX contact_profiles_index (display_name=?)
Query: SELECT index_in_group, member_relations_vector FROM group_members WHERE local_display_name = ?
Plan:
SCAN group_members
Query: SELECT issue_failed_since, issue_error FROM badge_purchases
Plan:
SCAN badge_purchases
Query: SELECT item_content FROM chat_items WHERE group_id = 1 ORDER BY chat_item_id DESC LIMIT 1
Plan:
SEARCH chat_items USING INDEX idx_chat_items_group_id (group_id=?)
Query: SELECT last_insert_rowid()
Plan:
SCAN CONSTANT ROW
@@ -7608,6 +7762,10 @@ Query: SELECT member_id FROM group_members WHERE local_display_name = ?
Plan:
SCAN group_members
Query: SELECT member_id FROM group_members WHERE member_category = ?
Plan:
SCAN group_members
Query: SELECT member_id FROM group_members WHERE member_role = ? LIMIT 1
Plan:
SCAN group_members
@@ -7668,6 +7826,10 @@ Query: SELECT member_xcontact_id, member_welcome_shared_msg_id FROM group_member
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
Query: SELECT next_wake_at, badge_purchase_id FROM badge_purchases
Plan:
SCAN badge_purchases
Query: SELECT note_folder_id FROM note_folders WHERE user_id = ?
Plan:
SEARCH note_folders USING COVERING INDEX note_folders_user_id (user_id=?)
@@ -7676,6 +7838,10 @@ Query: SELECT note_folder_id FROM note_folders WHERE user_id = ? LIMIT 1
Plan:
SEARCH note_folders USING COVERING INDEX note_folders_user_id (user_id=?)
Query: SELECT purchase_key FROM badge_code_redemptions
Plan:
SCAN badge_code_redemptions
Query: SELECT quota_err_counter FROM connections WHERE user_id = ? AND connection_id = ?
Plan:
SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)
@@ -7736,6 +7902,10 @@ Query: SELECT shared_msg_id FROM chat_items WHERE shared_msg_id IS NOT NULL ORDE
Plan:
SCAN chat_items
Query: SELECT short_descr FROM contact_profiles WHERE display_name = ? LIMIT 1
Plan:
SEARCH contact_profiles USING INDEX contact_profiles_index (display_name=?)
Query: SELECT should_sync FROM connections_sync WHERE connections_sync_id = 1
Plan:
SEARCH connections_sync USING INTEGER PRIMARY KEY (rowid=?)
@@ -7768,7 +7938,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=?)
@@ -7792,6 +7962,10 @@ Query: UPDATE badge_purchases SET next_wake_at = ? WHERE badge_purchase_id = ?
Plan:
SEARCH badge_purchases USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE chat_items SET item_content = ?, item_text = ?, updated_at = ? WHERE chat_item_id = ?
Plan:
SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE chat_items SET item_msg_body = ?, item_chat_binding = ?, item_signatures = ?, item_signed_by_group_member_id = ? WHERE chat_item_id = ? AND include_in_history = 1
Plan:
SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?)
@@ -7868,6 +8042,10 @@ Query: UPDATE contact_profiles SET contact_domain = ?, updated_at = ? WHERE user
Plan:
SEARCH contact_profiles USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE contact_profiles SET contact_domain_verified = NULL WHERE user_id = ? AND contact_profile_id = ?
Plan:
SEARCH contact_profiles USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE contact_profiles SET image = ? WHERE display_name = ?
Plan:
SEARCH contact_profiles USING INDEX contact_profiles_index (display_name=?)
@@ -8008,6 +8186,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=?)
@@ -8044,6 +8226,10 @@ Query: UPDATE group_members SET roster_served_version = ?, updated_at = ? WHERE
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE group_members SET sent_inv_queue_info = ?, invited_via_group_member_id = ? WHERE group_member_id = ?
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE group_members SET support_chat_items_member_attention = ?, updated_at = ? WHERE group_member_id = ?
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
@@ -8060,6 +8246,14 @@ Query: UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE g
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
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=?)
@@ -8116,6 +8310,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
@@ -8220,6 +8418,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
src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql
+18 -1
View File
@@ -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
@@ -259,6 +260,7 @@ CREATE TABLE group_members(
roster_served_version INTEGER,
member_security_code TEXT,
member_security_code_verified_at TEXT,
invited_via_group_member_id INTEGER REFERENCES group_members(group_member_id) ON DELETE SET NULL,
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
@@ -390,6 +392,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 +984,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
@@ -1544,6 +1558,9 @@ CREATE INDEX idx_badge_code_redemptions_user ON badge_code_redemptions(
CREATE UNIQUE INDEX idx_badge_purchases_code_redemption ON badge_purchases(
badge_code_redemption_id
);
CREATE INDEX idx_group_members_invited_via_group_member_id ON group_members(
invited_via_group_member_id
);
CREATE TRIGGER on_group_members_insert_update_summary
AFTER INSERT ON group_members
FOR EACH ROW
src/Simplex/Chat/Store/Shared.hs
+28 -26
View File
@@ -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
@@ -74,6 +74,7 @@ data ChatLockEntity
| CLContactRequest Int64
| CLFile Int64
| CLBadgeUser Int64 -- one signed badge request per profile in flight
| CLUserProfile
deriving (Eq, Ord)
-- These error type constructors must be added to mobile apps
@@ -413,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 (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
@@ -558,7 +559,7 @@ toContactRequest now ((contactRequestId, localDisplayName, agentInvitationId, co
userQuery :: Query
userQuery =
[sql|
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
FROM users u
@@ -566,9 +567,9 @@ userQuery =
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
|]
toUser :: UTCTime -> (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName, Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, BoolInt, BoolInt, Maybe UIThemeEntityOverrides) :. BadgeRow :. ContactDomainRow -> User
toUser now ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, description, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, BI autoAcceptGroupInv, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, BI userChatRelay, BI clientService, uiThemes) :. badgeRow :. domainRow) =
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts, autoAcceptGroupInvitations, viewPwdHash, userMemberProfileUpdatedAt, userChatRelay = BoolDef userChatRelay, clientService = BoolDef clientService, uiThemes}
toUser :: UTCTime -> (UserId, UserId, ContactId, ProfileId, BoolInt, Int64, ContactName) :. (ContactName, Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, BoolInt, BoolInt, Maybe UIThemeEntityOverrides) :. BadgeRow :. ContactDomainRow -> User
toUser now ((userId, auId, userContactId, profileId, BI activeUser, activeOrder, localDisplayName) :. (displayName, fullName, shortDescr, description, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, BI autoAcceptGroupInv, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, BI userChatRelay, BI clientService, uiThemes) :. badgeRow :. domainRow) =
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts, autoAcceptGroupInvitations, viewPwdHash, userMemberProfileUpdatedAt, userChatRelay = BoolDef userChatRelay, clientService = BoolDef clientService, uiThemes}
where
profile = LocalProfile {profileId, displayName, fullName, shortDescr, description, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, localBadge = rowToBadge now badgeRow, preferences = userPreferences, localAlias = ""}
fullPreferences = fullPreferences' userPreferences
@@ -588,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.
@@ -746,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}
@@ -784,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 ->
@@ -810,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) =
@@ -937,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
@@ -953,8 +954,9 @@ getGroupInfoRow db cxt User {userId, userContactId} groupId = ExceptT $ do
firstRow (toGroupInfo currentTs cxt userContactId chatTags) (SEGroupNotFound groupId) $
DB.query
db
(groupInfoQuery <> " WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ?")
(groupId, userId, userContactId)
-- mu.user_id steers the planner to idx_group_members_group_id; contact_id index is quadratic over all groups
(groupInfoQuery <> " WHERE g.group_id = ? AND g.user_id = ? AND mu.user_id = ? AND mu.contact_id = ?")
(groupId, userId, userId, userContactId)
setPreparedGroupLinkInfo_ :: DB.Connection -> GroupInfo -> ConnReqContact -> ConnReqUriHash -> Maybe Int64 -> Maybe Int64 -> UTCTime -> IO ()
setPreparedGroupLinkInfo_ db GroupInfo {groupId, membership} cReq cReqHash customUserProfileId publicMemberCount_ currentTs = do
src/Simplex/Chat/Terminal/Input.hs
+1
View File
@@ -82,6 +82,7 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
CRContactDeleted u c -> whenCurrUser cc u $ unsetActiveContact ct c
CRGroupDeletedUser u g _ _ -> whenCurrUser cc u $ unsetActiveGroup ct g
CRSentGroupInvitation u g _ _ -> whenCurrUser cc u $ setActiveGroup ct g
CRSentGroupInvitationViaGroup u g _ _ _ -> whenCurrUser cc u $ setActiveGroup ct g
CRCmdOk _ -> case cmd of
Right APIDeleteUser {} -> setActive ct ""
_ -> pure ()
src/Simplex/Chat/Terminal/Output.hs
+3
View File
@@ -198,6 +198,9 @@ chatEventNotification t@ChatTerminal {sendNotification} cc = \case
CEvtReceivedGroupInvitation u g ct _ _ ->
when (contactNtf u ct False) $
sendNtf ("#" <> viewGroupName g <> " " <> viewContactName ct <> "> ", "invited you to join the group")
CEvtReceivedGroupInvitationViaGroup u g viaG m _ _ ->
when (groupNtf u viaG False) $
sendNtf ("#" <> viewGroupName g <> " " <> viewMemberName m <> "> ", "invited you to join the group")
CEvtUserJoinedGroup u g _ -> when (groupNtf u g False) $ do
whenCurrUser cc u $ setActiveGroup t g
sendNtf ("#" <> viewGroupName g, "you are connected to group")
src/Simplex/Chat/Types.hs
+21 -8
View File
@@ -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
@@ -316,6 +316,13 @@ contactActive Contact {contactStatus} = contactStatus == CSActive
contactDeleted :: Contact -> Bool
contactDeleted Contact {contactStatus} = contactStatus == CSDeleted || contactStatus == CSDeletedByUser
contactUpdatableFromMember :: Contact -> Bool
contactUpdatableFromMember ct
| not (contactActive ct) = True
| otherwise = case contactConn ct of
Nothing -> True
Just conn -> not (connReady conn) || (authErrCounter conn >= 1)
contactSecurityCode :: Contact -> Maybe SecurityCode
contactSecurityCode Contact {activeConn} = connectionCode =<< activeConn
@@ -848,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
@@ -1000,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)
@@ -1078,8 +1090,7 @@ data MemberIdRole = MemberIdRole
deriving (Eq, Show)
data IntroInvitation = IntroInvitation
{ groupConnReq :: ConnReqInvitation,
directConnReq :: Maybe ConnReqInvitation
{ groupConnReq :: ConnReqInvitation
}
deriving (Eq, Show)
@@ -1204,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,
src/Simplex/Chat/Types/Preferences.hs
+14 -12
View File
@@ -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)
src/Simplex/Chat/View.hs
+7 -6
View File
@@ -208,6 +208,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, showFullLinks, te
-- CRGroupConversationsDeleted u _g _conversations -> ttyUser u []
CRGroupsList u gs -> ttyUser u $ viewGroupsList gs
CRSentGroupInvitation u g c _ -> ttyUser u $ viewSentGroupInvitation g c
CRSentGroupInvitationViaGroup u g _ viaG viaM -> ttyUser u ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyMember viaM <> " in " <> ttyGroup' viaG]
CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus
CRFileTransferStatusXFTP u ci -> ttyUser u $ viewFileTransferStatusXFTP ci
CRUserProfile u@User {profile = LocalProfile {localBadge}} p -> ttyUser u $ viewUserProfile localBadge p
@@ -514,7 +515,8 @@ chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView}
in ttyUser u [sShow connId <> ": END"]
CEvtSubscriptionStatus srv status conns -> [plain $ subStatusStr status <> " " <> tshow (length conns) <> " connections on server " <> showSMPServer srv]
CEvtServiceSubStatus srv event -> [plain $ serviceSubEventStr srv event]
CEvtReceivedGroupInvitation {user = u, groupInfo = g, contact = c, memberRole = r} -> ttyUser u $ viewReceivedGroupInvitation g c r
CEvtReceivedGroupInvitation {user = u, groupInfo = g, contact = c, memberRole = r} -> ttyUser u $ viewReceivedGroupInvitation g (ttyContact' c) r
CEvtReceivedGroupInvitationViaGroup {user = u, groupInfo = g, viaGroupInfo = viaG, viaMember = m, memberRole = r} -> ttyUser u $ viewReceivedGroupInvitation g (ttyMember m <> " in " <> ttyGroup' viaG) r
CEvtUserJoinedGroup u g m -> ttyUser u $ viewUserJoinedGroup g m
CEvtGroupLinkDataUpdated u g groupLink relays relaysChanged
| relaysChanged -> ttyUser u $ viewGroupLinkRelaysUpdated g groupLink relays
@@ -732,7 +734,6 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa
GroupChat g scopeInfo -> case chatDir of
CIGroupSnd -> case content of
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to context mc
CISndGroupInvitation {} -> showSndItemProhibited to
_ -> showSndItem to
where
to = ttyToGroup g scopeInfo
@@ -743,7 +744,6 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from context mc
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
CIRcvMsgError err -> viewRcvMsgError from err ts tz meta
CIRcvGroupInvitation {} | isJust m_ -> showRcvItemProhibited from
CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g scopeInfo m_) context meta [plainContent content] False
CIRcvBlocked {} -> receivedWithTime_ ts tz (ttyFromGroup g scopeInfo m_) context meta [plainContent content] False
_ -> showRcvItem from
@@ -1402,9 +1402,9 @@ viewConnectedToGroupMember g@GroupInfo {groupId} m@GroupMember {groupMemberId, m
]
_ -> [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [StyledString]
viewReceivedGroupInvitation g c role =
ttyFullGroup g <> ": " <> ttyContact' c <> " invites you to join the group as " <> showRole role
viewReceivedGroupInvitation :: GroupInfo -> StyledString -> GroupMemberRole -> [StyledString]
viewReceivedGroupInvitation g inviter role =
ttyFullGroup g <> ": " <> inviter <> " invites you to join the group as " <> showRole role
: case incognitoMembershipProfile g of
Just mp -> ["use " <> highlight ("/j " <> viewGroupName g) <> " to join incognito as " <> incognitoProfile' (fromLocalProfile mp)]
Nothing -> ["use " <> highlight ("/j " <> viewGroupName g) <> " to accept"]
@@ -1961,6 +1961,7 @@ viewRcvQueuesInfo = plain . T.intercalate ", " . map showQueueInfo
RSSendingQADD -> "switch started"
RSSendingQUSE -> "switch confirmed"
RSReceivedMessage -> "switch secured"
RSReceivedQEND -> "switch completed"
viewSndQueuesInfo :: [SndQueueInfo] -> StyledString
viewSndQueuesInfo = plain . T.intercalate ", " . map showQueueInfo
src/Simplex/Chat/Web.hs
+5 -2
View File
@@ -16,6 +16,7 @@ module Simplex.Chat.Web
webPreviewWorker,
writeCorsConfig,
removeStaleFiles,
publicGroupIdFileName,
channelContentChanged,
channelProfileUpdated,
channelRemoved,
@@ -416,9 +417,11 @@ removeStaleFiles dir activeFiles = do
let f' = if takeExtension f == ".tmp" then dropExtension f else f
base = dropExtension f'
in takeExtension f' == ".json" && not (null base) && all isBase64Url base
isBase64Url c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c == '-' || c == '_'
isBase64Url c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c == '-' || c == '_' || c == '='
allFiles <- S.filter isPreviewFile . S.fromList <$> listDirectory dir
mapM_ (\f -> removeFile (dir </> f)) $ S.difference allFiles activeFiles
forM_ (S.difference allFiles activeFiles) $ \f ->
removeFile (dir </> f) `catchOwn'` \(e :: SomeException) ->
logError $ "web preview: error removing stale file " <> T.pack f <> ": " <> tshow e
toFormattedText :: Text -> Maybe MarkdownList
toFormattedText t = case parseMaybeMarkdownList t of
src/Simplex/Chat/protocol.md
+2 -4
View File
@@ -197,8 +197,7 @@ Events:
{
"memberId": "<member ID>",
"memberIntro": {
"groupConnReq": "<group conn req>",
"directConnReq": "<direct conn req>"
"groupConnReq": "<group conn req>"
}
}
@@ -214,8 +213,7 @@ Events:
},
},
"memberIntro": {
"groupConnReq": "<group conn req>",
"directConnReq": "<direct conn req>"
"groupConnReq": "<group conn req>"
}
}