core: superpeers data model first draft (#5641)

This commit is contained in:
spaced4ndy 2025-02-21 13:53:27 +04:00 committed by GitHub
parent 704bab171d
commit f0918a8e9d
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
24 changed files with 533 additions and 159 deletions

View file

@ -95,6 +95,7 @@ library
Simplex.Chat.Options.Postgres
Simplex.Chat.Store.Postgres.Migrations
Simplex.Chat.Store.Postgres.Migrations.M20241220_initial
Simplex.Chat.Store.Postgres.Migrations.M20250217_superpeers
else
exposed-modules:
Simplex.Chat.Archive
@ -224,6 +225,7 @@ library
Simplex.Chat.Store.SQLite.Migrations.M20250126_mentions
Simplex.Chat.Store.SQLite.Migrations.M20250129_delete_unused_contacts
Simplex.Chat.Store.SQLite.Migrations.M20250130_indexes
Simplex.Chat.Store.SQLite.Migrations.M20250217_superpeers
other-modules:
Paths_simplex_chat
hs-source-dirs:

View file

@ -42,6 +42,7 @@ import Simplex.Messaging.Agent as Agent
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), ServerCfg (..), ServerRoles (..), allRoles, createAgentStore, defaultAgentConfig, presetServerCfg)
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.Store.Common (DBStore (dbNew))
import Simplex.Messaging.Encoding.String
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError)
import Simplex.Messaging.Client (defaultNetworkConfig)
@ -99,14 +100,18 @@ defaultChatConfig =
smp = simplexChatSMPServers,
useSMP = 4,
xftp = map (presetServer True) $ L.toList defaultXFTPServers,
useXFTP = 3
useXFTP = 3,
superpeers = simplexChatSuperpeers,
useSuperpeers = 2
},
PresetOperator
{ operator = Just operatorFlux,
smp = fluxSMPServers,
useSMP = 3,
xftp = fluxXFTPServers,
useXFTP = 3
useXFTP = 3,
superpeers = [],
useSuperpeers = 0
}
],
ntf = _defaultNtfServers,
@ -156,6 +161,14 @@ simplexChatSMPServers =
"smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
]
-- TODO [superpeers] real superpeers
simplexChatSuperpeers :: [NewUserSuperpeer]
simplexChatSuperpeers =
[ presetSuperpeer True "superpeer1" ["simplex.im"] (either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp111.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D"),
presetSuperpeer True "superpeer2" ["simplex.im"] (either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp222.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D"),
presetSuperpeer True "superpeer3" ["simplex.im"] (either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp333.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D")
]
fluxSMPServers :: [NewUserServer 'PSMP]
fluxSMPServers =
map
@ -304,7 +317,9 @@ newChatController
smp = map newUserServer smpSrvs,
useSMP = 0,
xftp = map newUserServer xftpSrvs,
useXFTP = 0
useXFTP = 0,
superpeers = [],
useSuperpeers = 0
}
randomServerCfgs :: UserProtocol p => String -> SProtocolType p -> [(Text, ServerOperator)] -> [PresetOperator] -> IO (NonEmpty (ServerCfg p))
randomServerCfgs name p opDomains rndSrvs =
@ -325,7 +340,8 @@ newChatController
getServers ops opDomains user' = do
smpSrvs <- getProtocolServers db SPSMP user'
xftpSrvs <- getProtocolServers db SPXFTP user'
uss <- groupByOperator' (ops, smpSrvs, xftpSrvs)
speers <- getSuperpeers db user'
uss <- groupByOperator' (ops, smpSrvs, xftpSrvs, speers)
ts <- getCurrentTime
uss' <- mapM (setUserServers' db user' ts . updatedUserServers) uss
let auId = aUserId user'

View file

@ -617,7 +617,7 @@ data ChatResponse
| CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure}
| CRServerOperatorConditions {conditions :: ServerOperatorConditions}
| CRUserServers {user :: User, userServers :: [UserOperatorServers]}
| CRUserServersValidation {user :: User, serverErrors :: [UserServersError]}
| CRUserServersValidation {user :: User, serverErrors :: [UserServersError], serverWarnings :: [UserServersWarning]}
| CRUsageConditions {usageConditions :: UsageConditions, conditionsText :: Text, acceptedConditions :: Maybe UsageConditions}
| CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
| CRNetworkConfig {networkConfig :: NetworkConfig}
@ -1218,6 +1218,7 @@ data ChatErrorType
| CEUserUnknown
| CEActiveUserExists -- TODO delete
| CEUserExists {contactName :: ContactName}
| CESuperpeerExists
| CEDifferentActiveUser {commandUserId :: UserId, activeUserId :: UserId}
| CECantDeleteActiveUser {userId :: UserId}
| CECantDeleteLastUser {userId :: UserId}

View file

@ -105,7 +105,7 @@ createActiveUser cc = do
loop = do
displayName <- T.pack <$> getWithPrompt "display name"
let profile = Just Profile {displayName, fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}
execChatCommand' (CreateActiveUser NewUser {profile, pastTimestamp = False}) `runReaderT` cc >>= \case
execChatCommand' (CreateActiveUser NewUser {profile, pastTimestamp = False, userSuperpeer = False}) `runReaderT` cc >>= \case
CRActiveUser user -> pure user
r -> do
ts <- getCurrentTime

View file

@ -308,19 +308,20 @@ processChatCommand cmd =
processChatCommand' :: VersionRangeChat -> ChatCommand -> CM ChatResponse
processChatCommand' vr = \case
ShowActiveUser -> withUser' $ pure . CRActiveUser
CreateActiveUser NewUser {profile, pastTimestamp} -> do
CreateActiveUser NewUser {profile, pastTimestamp, userSuperpeer} -> do
forM_ profile $ \Profile {displayName} -> checkValidName displayName
p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile
u <- asks currentUser
users <- withFastStore' getUsers
forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash} ->
forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash, userSuperpeer = userSuperpeer'} -> do
when (n == displayName) . throwChatError $
if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""}
when (userSuperpeer && userSuperpeer') $ throwChatError CESuperpeerExists
(uss, (smp', xftp')) <- chooseServers =<< readTVarIO u
auId <- withAgent $ \a -> createUser a smp' xftp'
ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure
user <- withFastStore $ \db -> do
user <- createUserRecordAt db (AgentUserId auId) p True ts
user <- createUserRecordAt db (AgentUserId auId) p userSuperpeer True ts
mapM_ (setUserServers db user ts) uss
createPresetContactCards db user `catchStoreError` \_ -> pure ()
createNoteFolder db user
@ -346,9 +347,16 @@ processChatCommand' vr = \case
let RandomAgentServers {smpServers = smp', xftpServers = xftp'} = as
pure (uss, (smp', xftp'))
copyServers :: UserOperatorServers -> UpdatedUserOperatorServers
copyServers UserOperatorServers {operator, smpServers, xftpServers} =
let new srv = AUS SDBNew srv {serverId = DBNewEntity}
in UpdatedUserOperatorServers {operator, smpServers = map new smpServers, xftpServers = map new xftpServers}
copyServers UserOperatorServers {operator, smpServers, xftpServers, superpeers} =
let newSrv srv = AUS SDBNew srv {serverId = DBNewEntity}
newSpeer speer = AUSP SDBNew speer {superpeerId = DBNewEntity}
in
UpdatedUserOperatorServers {
operator,
smpServers = map newSrv smpServers,
xftpServers = map newSrv xftpServers,
superpeers = map newSpeer superpeers
}
coupleDaysAgo t = (`addUTCTime` t) . fromInteger . negate . (+ (2 * day)) <$> randomRIO (0, day)
day = 86400
ListUsers -> CRUsersList <$> withFastStore' getUsersInfo
@ -1354,7 +1362,8 @@ processChatCommand' vr = \case
getServers db as ops opDomains user = do
smpSrvs <- getProtocolServers db SPSMP user
xftpSrvs <- getProtocolServers db SPXFTP user
uss <- groupByOperator (ops, smpSrvs, xftpSrvs)
speers <- getSuperpeers db user
uss <- groupByOperator (ops, smpSrvs, xftpSrvs, speers)
pure $ (aUserId user,) $ useServers as opDomains uss
SetServerOperators operatorsRoles -> do
ops <- serverOperators <$> withFastStore getServerOperators
@ -1369,8 +1378,9 @@ processChatCommand' vr = \case
APIGetUserServers userId -> withUserId userId $ \user -> withFastStore $ \db -> do
CRUserServers user <$> (liftIO . groupByOperator =<< getUserServers db user)
APISetUserServers userId userServers -> withUserId userId $ \user -> do
errors <- validateAllUsersServers userId $ L.toList userServers
(errors, warnings) <- validateAllUsersServers userId $ L.toList userServers
unless (null errors) $ throwChatError (CECommandError $ "user servers validation error(s): " <> show errors)
unless (null warnings) $ logWarn $ "user servers validation warning(s): " <> tshow warnings
uss <- withFastStore $ \db -> do
ts <- liftIO getCurrentTime
mapM (setUserServers db user ts) userServers
@ -1383,7 +1393,7 @@ processChatCommand' vr = \case
setProtocolServers a auId xftp'
ok_
APIValidateServers userId userServers -> withUserId userId $ \user ->
CRUserServersValidation user <$> validateAllUsersServers userId userServers
uncurry (CRUserServersValidation user) <$> validateAllUsersServers userId userServers
APIGetUsageConditions -> do
(usageConditions, acceptedConditions) <- withFastStore $ \db -> do
usageConditions <- getCurrentUsageConditions db
@ -2784,7 +2794,7 @@ processChatCommand' vr = \case
withServerProtocol p action = case userProtocol p of
Just Dict -> action
_ -> throwChatError $ CEServerProtocol $ AProtocolType p
validateAllUsersServers :: UserServersClass u => Int64 -> [u] -> CM [UserServersError]
validateAllUsersServers :: UserServersClass u => Int64 -> [u] -> CM ([UserServersError], [UserServersWarning])
validateAllUsersServers currUserId userServers = withFastStore $ \db -> do
users' <- filter (\User {userId} -> userId /= currUserId) <$> liftIO (getUsers db)
others <- mapM (getUserOperatorServers db) users'
@ -3251,18 +3261,21 @@ processChatCommand' vr = \case
msgInfo <- withFastStore' (`getLastRcvMsgInfo` connId)
CRQueueInfo user msgInfo <$> withAgent (`getConnectionQueueInfo` acId)
protocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
protocolServers p (operators, smpServers, xftpServers) = case p of
SPSMP -> (operators, smpServers, [])
SPXFTP -> (operators, [], xftpServers)
-- TODO [superpeers] used for CLI specific APIs (same for `updatedServers` below) - add similar APIs for superpeers?
protocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserSuperpeer]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserSuperpeer])
protocolServers p (operators, smpServers, xftpServers, _superpeers) = case p of
SPSMP -> (operators, smpServers, [], [])
SPXFTP -> (operators, [], xftpServers, [])
-- disable preset and replace custom servers (groupByOperator always adds custom)
updatedServers :: forall p. UserProtocol p => SProtocolType p -> [AUserServer p] -> UserOperatorServers -> UpdatedUserOperatorServers
updatedServers p' srvs UserOperatorServers {operator, smpServers, xftpServers} = case p' of
SPSMP -> u (updateSrvs smpServers, map (AUS SDBStored) xftpServers)
SPXFTP -> u (map (AUS SDBStored) smpServers, updateSrvs xftpServers)
updatedServers p' srvs UserOperatorServers {operator, smpServers, xftpServers, superpeers} = case p' of
SPSMP -> u (updateSrvs smpServers, map (AUS SDBStored) xftpServers, map (AUSP SDBStored) superpeers)
SPXFTP -> u (map (AUS SDBStored) smpServers, updateSrvs xftpServers, map (AUSP SDBStored) superpeers)
where
u = uncurry $ UpdatedUserOperatorServers operator
u = uncurry3 $ UpdatedUserOperatorServers operator
uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)
uncurry3 f ~(a,b,c) = f a b c
updateSrvs :: [UserServer p] -> [AUserServer p]
updateSrvs pSrvs = map disableSrv pSrvs <> maybe srvs (const []) operator
disableSrv srv@UserServer {preset} =
@ -3665,7 +3678,8 @@ chatCommandP =
"/block #" *> (SetShowMemberMessages <$> displayNameP <* A.space <*> (char_ '@' *> displayNameP) <*> pure False),
"/unblock #" *> (SetShowMemberMessages <$> displayNameP <* A.space <*> (char_ '@' *> displayNameP) <*> pure True),
"/_create user " *> (CreateActiveUser <$> jsonP),
"/create user " *> (CreateActiveUser <$> newUserP),
"/create user " *> (CreateActiveUser <$> newUserP False),
"/create superpeer user " *> (CreateActiveUser <$> newUserP True),
"/users" $> ListUsers,
"/_user " *> (APISetActiveUser <$> A.decimal <*> optional (A.space *> jsonP)),
("/user " <|> "/u ") *> (SetActiveUser <$> displayNameP <*> optional (A.space *> pwdP)),
@ -4065,10 +4079,10 @@ chatCommandP =
pure UserMsgReceiptSettings {enable, clearOverrides}
onOffP = ("on" $> True) <|> ("off" $> False)
profileNames = (,) <$> displayNameP <*> fullNameP
newUserP = do
newUserP userSuperpeer = do
(cName, fullName) <- profileNames
let profile = Just Profile {displayName = cName, fullName, image = Nothing, contactLink = Nothing, preferences = Nothing}
pure NewUser {profile, pastTimestamp = False}
pure NewUser {profile, pastTimestamp = False, userSuperpeer}
jsonP :: J.FromJSON a => Parser a
jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
groupProfile = do

View file

@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
@ -47,9 +48,10 @@ import Data.Time.Clock (UTCTime, nominalDay)
import Language.Haskell.TH.Syntax (lift)
import Simplex.Chat.Operators.Conditions
import Simplex.Chat.Options.DB (FromField (..), ToField (..))
import Simplex.Chat.Types (User)
import Simplex.Chat.Types (ConnReqContact, User)
import Simplex.Chat.Types.Util (textParseJSON)
import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles)
import Simplex.Messaging.Agent.Protocol (sameConnReqContact)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, sumTypeJSON)
import Simplex.Messaging.Protocol (AProtocolType (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI, SProtocolType (..), UserProtocol)
@ -220,14 +222,16 @@ conditionsAccepted ServerOperator {conditionsAcceptance} = case conditionsAccept
data UserOperatorServers = UserOperatorServers
{ operator :: Maybe ServerOperator,
smpServers :: [UserServer 'PSMP],
xftpServers :: [UserServer 'PXFTP]
xftpServers :: [UserServer 'PXFTP],
superpeers :: [UserSuperpeer]
}
deriving (Show)
data UpdatedUserOperatorServers = UpdatedUserOperatorServers
{ operator :: Maybe ServerOperator,
smpServers :: [AUserServer 'PSMP],
xftpServers :: [AUserServer 'PXFTP]
xftpServers :: [AUserServer 'PXFTP],
superpeers :: [AUserSuperpeer]
}
deriving (Show)
@ -236,25 +240,34 @@ data ValidatedProtoServer p = ValidatedProtoServer {unVPS :: Either Text (ProtoS
class UserServersClass u where
type AServer u = (s :: ProtocolType -> Type) | s -> u
type ASuperpeer u = (s :: Type) | s -> u
operator' :: u -> Maybe ServerOperator
aUserServer' :: AServer u p -> AUserServer p
servers' :: UserProtocol p => SProtocolType p -> u -> [AServer u p]
superpeers' :: u -> [ASuperpeer u]
aUserSuperpeer' :: ASuperpeer u -> AUserSuperpeer
instance UserServersClass UserOperatorServers where
type AServer UserOperatorServers = UserServer' 'DBStored
type ASuperpeer UserOperatorServers = UserSuperpeer' 'DBStored
operator' UserOperatorServers {operator} = operator
aUserServer' = AUS SDBStored
servers' p UserOperatorServers {smpServers, xftpServers} = case p of
SPSMP -> smpServers
SPXFTP -> xftpServers
superpeers' UserOperatorServers {superpeers} = superpeers
aUserSuperpeer' = AUSP SDBStored
instance UserServersClass UpdatedUserOperatorServers where
type AServer UpdatedUserOperatorServers = AUserServer
type ASuperpeer UpdatedUserOperatorServers = AUserSuperpeer
operator' UpdatedUserOperatorServers {operator} = operator
aUserServer' = id
servers' p UpdatedUserOperatorServers {smpServers, xftpServers} = case p of
SPSMP -> smpServers
SPXFTP -> xftpServers
superpeers' UpdatedUserOperatorServers {superpeers} = superpeers
aUserSuperpeer' = id
type UserServer p = UserServer' 'DBStored p
@ -274,12 +287,34 @@ data UserServer' s (p :: ProtocolType) = UserServer
}
deriving (Show)
type UserSuperpeer = UserSuperpeer' 'DBStored
type NewUserSuperpeer = UserSuperpeer' 'DBNew
data AUserSuperpeer = forall s. AUSP (SDBStored s) (UserSuperpeer' s)
deriving instance Show AUserSuperpeer
data UserSuperpeer' s = UserSuperpeer
{ superpeerId :: DBEntityId' s,
address :: ConnReqContact,
name :: Text,
domains :: [Text],
preset :: Bool,
tested :: Maybe Bool,
enabled :: Bool,
deleted :: Bool
}
deriving (Show)
data PresetOperator = PresetOperator
{ operator :: Maybe NewServerOperator,
smp :: [NewUserServer 'PSMP],
useSMP :: Int,
xftp :: [NewUserServer 'PXFTP],
useXFTP :: Int
useXFTP :: Int,
superpeers :: [NewUserSuperpeer],
useSuperpeers :: Int
}
deriving (Show)
@ -298,14 +333,28 @@ operatorServersToUse p PresetOperator {useSMP, useXFTP} = case p of
presetServer :: Bool -> ProtoServerWithAuth p -> NewUserServer p
presetServer = newUserServer_ True
{-# INLINE presetServer #-}
newUserServer :: ProtoServerWithAuth p -> NewUserServer p
newUserServer = newUserServer_ False True
{-# INLINE newUserServer #-}
newUserServer_ :: Bool -> Bool -> ProtoServerWithAuth p -> NewUserServer p
newUserServer_ preset enabled server =
UserServer {serverId = DBNewEntity, server, preset, tested = Nothing, enabled, deleted = False}
presetSuperpeer :: Bool -> Text -> [Text] -> ConnReqContact -> NewUserSuperpeer
presetSuperpeer = newSuperpeer_ True
{-# INLINE presetSuperpeer #-}
newSuperpeer :: Text -> [Text] -> ConnReqContact -> NewUserSuperpeer
newSuperpeer = newSuperpeer_ False True
{-# INLINE newSuperpeer #-}
newSuperpeer_ :: Bool -> Bool -> Text -> [Text] -> ConnReqContact -> NewUserSuperpeer
newSuperpeer_ preset enabled name domains !address =
UserSuperpeer {superpeerId = DBNewEntity, address, name, domains, preset, tested = Nothing, enabled, deleted = False}
-- This function should be used inside DB transaction to update conditions in the database
-- it evaluates to (current conditions, and conditions to add)
usageConditionsToAdd :: Bool -> UTCTime -> [UsageConditions] -> (UsageConditions, [UsageConditions])
@ -333,8 +382,8 @@ usageConditionsToAdd' prevCommit sourceCommit newUser createdAt = \case
presetUserServers :: [(Maybe PresetOperator, Maybe ServerOperator)] -> [UpdatedUserOperatorServers]
presetUserServers = mapMaybe $ \(presetOp_, op) -> mkUS op <$> presetOp_
where
mkUS op PresetOperator {smp, xftp} =
UpdatedUserOperatorServers op (map (AUS SDBNew) smp) (map (AUS SDBNew) xftp)
mkUS op PresetOperator {smp, xftp, superpeers} =
UpdatedUserOperatorServers op (map (AUS SDBNew) smp) (map (AUS SDBNew) xftp) (map (AUSP SDBNew) superpeers)
-- This function should be used inside DB transaction to update operators.
-- It allows to add/remove/update preset operators in the database preserving enabled and roles settings,
@ -355,7 +404,7 @@ updatedServerOperators presetOps storedOps =
-- This function should be used inside DB transaction to update servers.
updatedUserServers :: (Maybe PresetOperator, UserOperatorServers) -> UpdatedUserOperatorServers
updatedUserServers (presetOp_, UserOperatorServers {operator, smpServers, xftpServers}) =
UpdatedUserOperatorServers {operator, smpServers = smp', xftpServers = xftp'}
UpdatedUserOperatorServers {operator, smpServers = smp', xftpServers = xftp', superpeers = []}
where
stored = map (AUS SDBStored)
(smp', xftp') = case presetOp_ of
@ -368,7 +417,7 @@ updatedUserServers (presetOp_, UserOperatorServers {operator, smpServers, xftpSe
storedSrvs :: Map (ProtoServerWithAuth p) (UserServer p)
storedSrvs = foldl' (\ss srv@UserServer {server} -> M.insert server srv ss) M.empty srvs
customServer :: UserServer p -> Bool
customServer srv = not (preset srv) && all (`S.notMember` presetHosts) (srvHost srv)
customServer srv@UserServer {preset} = not preset && all (`S.notMember` presetHosts) (srvHost srv)
presetSrvs :: [NewUserServer p]
presetSrvs = pServers p presetOp
presetHosts :: Set TransportHost
@ -411,46 +460,58 @@ instance Box ((,) (Maybe a)) where
box = (Nothing,)
unbox = snd
groupByOperator :: ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> IO [UserOperatorServers]
groupByOperator (ops, smpSrvs, xftpSrvs) = map runIdentity <$> groupByOperator_ (map Identity ops, smpSrvs, xftpSrvs)
groupByOperator :: ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserSuperpeer]) -> IO [UserOperatorServers]
groupByOperator (ops, smpSrvs, xftpSrvs, speers) = map runIdentity <$> groupByOperator_ (map Identity ops, smpSrvs, xftpSrvs, speers)
-- For the initial app start this function relies on tuple being Functor/Box
-- to preserve the information about operator being DBNew or DBStored
groupByOperator' :: ([(Maybe PresetOperator, Maybe ServerOperator)], [UserServer 'PSMP], [UserServer 'PXFTP]) -> IO [(Maybe PresetOperator, UserOperatorServers)]
groupByOperator' :: ([(Maybe PresetOperator, Maybe ServerOperator)], [UserServer 'PSMP], [UserServer 'PXFTP], [UserSuperpeer]) -> IO [(Maybe PresetOperator, UserOperatorServers)]
groupByOperator' = groupByOperator_
{-# INLINE groupByOperator' #-}
groupByOperator_ :: forall f. (Box f, Traversable f) => ([f (Maybe ServerOperator)], [UserServer 'PSMP], [UserServer 'PXFTP]) -> IO [f UserOperatorServers]
groupByOperator_ (ops, smpSrvs, xftpSrvs) = do
groupByOperator_ :: forall f. (Box f, Traversable f) => ([f (Maybe ServerOperator)], [UserServer 'PSMP], [UserServer 'PXFTP], [UserSuperpeer]) -> IO [f UserOperatorServers]
groupByOperator_ (ops, smpSrvs, xftpSrvs, speers) = do
let ops' = mapMaybe sequence ops
customOp_ = find (isNothing . unbox) ops
ss <- mapM ((\op -> (serverDomains (unbox op),) <$> newIORef (mkUS . Just <$> op))) ops'
custom <- newIORef $ maybe (box $ mkUS Nothing) (mkUS <$>) customOp_
mapM_ (addServer ss custom addSMP) (reverse smpSrvs)
mapM_ (addServer ss custom addXFTP) (reverse xftpSrvs)
mapM_ (addSuperpeer ss custom) speers
opSrvs <- mapM (readIORef . snd) ss
customSrvs <- readIORef custom
pure $ opSrvs <> [customSrvs]
where
mkUS op = UserOperatorServers op [] []
mkUS op = UserOperatorServers op [] [] []
addServer :: [([Text], IORef (f UserOperatorServers))] -> IORef (f UserOperatorServers) -> (UserServer p -> UserOperatorServers -> UserOperatorServers) -> UserServer p -> IO ()
addServer ss custom add srv =
let v = maybe custom snd $ find (\(ds, _) -> any (\d -> any (matchingHost d) (srvHost srv)) ds) ss
in atomicModifyIORef'_ v (add srv <$>)
addSMP srv s@UserOperatorServers {smpServers} = (s :: UserOperatorServers) {smpServers = srv : smpServers}
addXFTP srv s@UserOperatorServers {xftpServers} = (s :: UserOperatorServers) {xftpServers = srv : xftpServers}
addSuperpeer :: [([Text], IORef (f UserOperatorServers))] -> IORef (f UserOperatorServers) -> UserSuperpeer -> IO ()
addSuperpeer ss custom speer =
let v = maybe custom snd $ find (\(ds, _) -> any (`elem` domains speer) ds) ss
in atomicModifyIORef'_ v (addSpeer <$>)
where
addSpeer s@UserOperatorServers {superpeers} = (s :: UserOperatorServers) {superpeers = speer : superpeers}
data UserServersError
= USENoServers {protocol :: AProtocolType, user :: Maybe User}
| USEStorageMissing {protocol :: AProtocolType, user :: Maybe User}
| USEProxyMissing {protocol :: AProtocolType, user :: Maybe User}
| USEDuplicateServer {protocol :: AProtocolType, duplicateServer :: Text, duplicateHost :: TransportHost}
| USEDuplicateSuperpeerName {duplicateSuperpeer :: Text}
| USEDuplicateSuperpeerAddress {duplicateSuperpeer :: Text, duplicateAddress :: ConnReqContact}
deriving (Show)
validateUserServers :: UserServersClass u' => [u'] -> [(User, [UserOperatorServers])] -> [UserServersError]
validateUserServers curr others = currUserErrs <> concatMap otherUserErrs others
data UserServersWarning = USWNoSuperpeers {user :: Maybe User}
deriving (Show)
validateUserServers :: UserServersClass u' => [u'] -> [(User, [UserOperatorServers])] -> ([UserServersError], [UserServersWarning])
validateUserServers curr others = (currUserErrs <> concatMap otherUserErrs others, currUserWarns <> concatMap otherUserWarns others)
where
currUserErrs = noServersErrs SPSMP Nothing curr <> noServersErrs SPXFTP Nothing curr <> serverErrs SPSMP curr <> serverErrs SPXFTP curr
currUserErrs = noServersErrs SPSMP Nothing curr <> noServersErrs SPXFTP Nothing curr <> serverErrs SPSMP curr <> serverErrs SPXFTP curr <> superpeerErrs curr
otherUserErrs (user, uss) = noServersErrs SPSMP (Just user) uss <> noServersErrs SPXFTP (Just user) uss
noServersErrs :: (UserServersClass u, ProtocolTypeI p, UserProtocol p) => SProtocolType p -> Maybe User -> [u] -> [UserServersError]
noServersErrs p user uss
@ -459,7 +520,6 @@ validateUserServers curr others = currUserErrs <> concatMap otherUserErrs others
where
p' = AProtocolType p
noServers cond = not $ any srvEnabled $ userServers p $ filter cond uss
opEnabled = maybe True (\ServerOperator {enabled} -> enabled) . operator'
hasRole roleSel = maybe True (\op@ServerOperator {enabled} -> enabled && roleSel (operatorRoles p op)) . operator'
srvEnabled (AUS _ UserServer {deleted, enabled}) = enabled && not deleted
serverErrs :: (UserServersClass u, ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [u] -> [UserServersError]
@ -470,13 +530,42 @@ validateUserServers curr others = currUserErrs <> concatMap otherUserErrs others
duplicateErr_ (AUS _ srv@UserServer {server}) =
USEDuplicateServer p' (safeDecodeUtf8 $ strEncode server)
<$> find (`S.member` duplicateHosts) (srvHost srv)
duplicateHosts = snd $ foldl' addHost (S.empty, S.empty) allHosts
duplicateHosts = snd $ foldl' addDuplicate (S.empty, S.empty) allHosts
allHosts = concatMap (\(AUS _ srv) -> L.toList $ srvHost srv) srvs
addHost (hs, dups) h
| h `S.member` hs = (hs, S.insert h dups)
| otherwise = (S.insert h hs, dups)
userServers :: (UserServersClass u, UserProtocol p) => SProtocolType p -> [u] -> [AUserServer p]
userServers p = map aUserServer' . concatMap (servers' p)
superpeerErrs :: UserServersClass u => [u] -> [UserServersError]
superpeerErrs uss = concatMap duplicateErrs_ speers
where
speers = filter (\(AUSP _ UserSuperpeer {deleted}) -> not deleted) $ userSuperpeers uss
duplicateErrs_ (AUSP _ UserSuperpeer {name, address}) =
[USEDuplicateSuperpeerName name | name `elem` duplicateNames]
<> [USEDuplicateSuperpeerAddress name address | address `elem` duplicateAddresses]
duplicateNames = snd $ foldl' addDuplicate (S.empty, S.empty) allNames
allNames = map (\(AUSP _ speer) -> name speer) speers
duplicateAddresses = snd $ foldl' addAddress ([], []) allAddresses
allAddresses = map (\(AUSP _ speer) -> address speer) speers
addAddress :: ([ConnReqContact], [ConnReqContact]) -> ConnReqContact -> ([ConnReqContact], [ConnReqContact])
addAddress (xs, dups) x
| any (sameConnReqContact x) xs = (xs, x : dups)
| otherwise = (x : xs, dups)
currUserWarns = noSuperpeersWarns Nothing curr
otherUserWarns (user, uss) = noSuperpeersWarns (Just user) uss
noSuperpeersWarns :: UserServersClass u => Maybe User -> [u] -> [UserServersWarning]
noSuperpeersWarns user uss
| noSuperpeers opEnabled = [USWNoSuperpeers user]
| otherwise = []
where
noSuperpeers cond = not $ any speerEnabled $ userSuperpeers $ filter cond uss
speerEnabled (AUSP _ UserSuperpeer {deleted, enabled}) = enabled && not deleted
userSuperpeers :: UserServersClass u => [u] -> [AUserSuperpeer]
userSuperpeers = map aUserSuperpeer' . concatMap superpeers'
opEnabled :: UserServersClass u => u -> Bool
opEnabled = maybe True (\ServerOperator {enabled} -> enabled) . operator'
addDuplicate :: Ord a => (Set a, Set a) -> a -> (Set a, Set a)
addDuplicate (xs, dups) x
| x `S.member` xs = (xs, S.insert x dups)
| otherwise = (S.insert x xs, dups)
instance ToJSON (DBEntityId' s) where
toEncoding = \case
@ -512,6 +601,16 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "UCA") ''UsageConditionsAction)
$(JQ.deriveJSON defaultJSON ''ServerOperatorConditions)
instance ToJSON (UserSuperpeer' s) where
toEncoding = $(JQ.mkToEncoding defaultJSON ''UserSuperpeer')
toJSON = $(JQ.mkToJSON defaultJSON ''UserSuperpeer')
instance DBStoredI s => FromJSON (UserSuperpeer' s) where
parseJSON = $(JQ.mkParseJSON defaultJSON ''UserSuperpeer')
instance FromJSON AUserSuperpeer where
parseJSON v = (AUSP SDBStored <$> parseJSON v) <|> (AUSP SDBNew <$> parseJSON v)
instance ProtocolTypeI p => ToJSON (UserServer' s p) where
toEncoding = $(JQ.mkToEncoding defaultJSON ''UserServer')
toJSON = $(JQ.mkToJSON defaultJSON ''UserServer')
@ -528,3 +627,5 @@ instance FromJSON UpdatedUserOperatorServers where
parseJSON = $(JQ.mkParseJSON defaultJSON ''UpdatedUserOperatorServers)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "USE") ''UserServersError)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "USW") ''UserServersWarning)

View file

@ -138,11 +138,11 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.member_restriction, mu.superpeer, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)

View file

@ -173,11 +173,11 @@ import Database.SQLite.Simple (Only (..), Query, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus, Maybe BoolInt) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked) :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences))
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked, Just superpeer) :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked, superpeer) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences))
toMaybeGroupMember _ _ = Nothing
createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO ()
@ -278,11 +278,11 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr = do
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.member_restriction, mu.superpeer, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences,
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.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.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
@ -469,7 +469,8 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
memberContactId = Just $ contactId' userOrContact,
memberContactProfileId = localProfileId (profile' userOrContact),
activeConn = Nothing,
memberChatVRange
memberChatVRange,
superpeer = False
}
where
memberChatVRange@(VersionRange minV maxV) = vr
@ -743,7 +744,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction, mu.superpeer,
mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
JOIN group_profiles gp USING (group_profile_id)
@ -806,7 +807,7 @@ groupMemberQuery :: Query
groupMemberQuery =
[sql|
SELECT
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences,
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.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.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
@ -975,7 +976,8 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId,
memberContactId = Just contactId,
memberContactProfileId = localProfileId profile,
activeConn = Nothing,
memberChatVRange = peerChatVRange
memberChatVRange = peerChatVRange,
superpeer = False
}
where
insertMember_ =
@ -1192,7 +1194,8 @@ createNewGroupMember db user gInfo invitingMember memInfo@MemberInfo {profile} m
memInvitedByGroupMemberId = Just $ groupMemberId' invitingMember,
localDisplayName,
memContactId = Nothing,
memProfileId
memProfileId,
superpeer = False
}
liftIO $ createNewMember_ db user gInfo newMember currentTs
@ -1220,7 +1223,8 @@ createNewMember_
memInvitedByGroupMemberId,
localDisplayName,
memContactId = memberContactId,
memProfileId = memberContactProfileId
memProfileId = memberContactProfileId,
superpeer
}
createdAt = do
let invitedById = fromInvitedBy userContactId invitedBy
@ -1230,12 +1234,12 @@ createNewMember_
db
[sql|
INSERT INTO group_members
(group_id, member_id, member_role, member_category, member_status, member_restriction, invited_by, invited_by_group_member_id,
(group_id, member_id, member_role, member_category, member_status, member_restriction, superpeer, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (groupId, memberId, memberRole, memberCategory, memberStatus, memRestriction, invitedById, memInvitedByGroupMemberId)
( (groupId, memberId, memberRole, memberCategory, memberStatus, memRestriction, BI superpeer, invitedById, memInvitedByGroupMemberId)
:. (userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt)
:. (minV, maxV)
)
@ -1257,7 +1261,8 @@ createNewMember_
memberContactId,
memberContactProfileId,
activeConn,
memberChatVRange
memberChatVRange,
superpeer
}
checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId)
@ -1444,7 +1449,7 @@ createIntroReMember
memRestriction = restriction <$> memRestrictions_
currentTs <- liftIO getCurrentTime
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs
let newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
let newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId, superpeer = False}
liftIO $ do
member <- createNewMember_ db user gInfo newMember currentTs
conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId chatV mcvr memberContactId cLevel currentTs subMode
@ -1506,11 +1511,11 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = do
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.member_restriction, mu.superpeer, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- via GroupMember
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences,
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.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.snd_file_id, c.rcv_file_id, c.user_contact_link_id,

View file

@ -514,7 +514,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
SELECT i.chat_item_id,
-- GroupMember
m.group_member_id, m.group_id, 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,
m.member_status, m.show_messages, m.member_restriction, m.superpeer, 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.image, p.contact_link, p.local_alias, p.preferences
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
@ -2519,17 +2519,17 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
i.forwarded_by_group_member_id,
-- GroupMember
m.group_member_id, m.group_id, 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,
m.member_status, m.show_messages, m.member_restriction, m.superpeer, 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.image, p.contact_link, p.local_alias, p.preferences,
-- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
rm.member_status, rm.show_messages, rm.member_restriction, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rm.member_status, rm.show_messages, rm.member_restriction, rm.superpeer, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
-- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.superpeer, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id

View file

@ -5,11 +5,13 @@ module Simplex.Chat.Store.Postgres.Migrations (migrations) where
import Data.List (sortOn)
import Data.Text (Text)
import Simplex.Chat.Store.Postgres.Migrations.M20241220_initial
import Simplex.Chat.Store.Postgres.Migrations.M20250217_superpeers
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Text, Maybe Text)]
schemaMigrations =
[ ("20241220_initial", m20241220_initial, Nothing)
[ ("20241220_initial", m20241220_initial, Nothing),
("20250217_superpeers", m20250217_superpeers, Just down_m20250217_superpeers)
]
-- | The list of migrations in ascending order by date

View file

@ -0,0 +1,46 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.Postgres.Migrations.M20250217_superpeers where
import Data.Text (Text)
import qualified Data.Text as T
import Text.RawString.QQ (r)
m20250217_superpeers :: Text
m20250217_superpeers =
T.pack
[r|
CREATE TABLE superpeers(
superpeer_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
address TEXT NOT NULL,
name TEXT NOT NULL,
domains TEXT NOT NULL,
preset SMALLINT NOT NULL DEFAULT 0,
tested SMALLINT,
enabled SMALLINT NOT NULL DEFAULT 1,
user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
created_at TEXT NOT NULL DEFAULT (now()),
updated_at TEXT NOT NULL DEFAULT (now()),
UNIQUE(user_id, address),
UNIQUE(user_id, name)
);
CREATE INDEX idx_superpeers_user_id ON superpeers(user_id);
ALTER TABLE users ADD COLUMN user_superpeer SMALLINT NOT NULL DEFAULT 0;
ALTER TABLE group_members ADD COLUMN superpeer SMALLINT NOT NULL DEFAULT 0;
|]
down_m20250217_superpeers :: Text
down_m20250217_superpeers =
T.pack
[r|
ALTER TABLE group_members DROP COLUMN superpeer;
ALTER TABLE users DROP COLUMN user_superpeer;
DROP INDEX idx_superpeers_user_id;
DROP TABLE superpeers;
|]

View file

@ -51,7 +51,7 @@ module Simplex.Chat.Store.Profiles
getContactWithoutConnViaAddress,
updateUserAddressAutoAccept,
getProtocolServers,
insertProtocolServer,
getSuperpeers,
getUpdateServerOperators,
getServerOperators,
getUserServers,
@ -117,11 +117,11 @@ import Database.SQLite.Simple (Only (..), Query, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif
createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User
createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime
createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> Bool -> ExceptT StoreError IO User
createUserRecord db auId p userSuperpeer activeUser = createUserRecordAt db auId p userSuperpeer activeUser =<< liftIO getCurrentTime
createUserRecordAt :: DB.Connection -> AgentUserId -> Profile -> Bool -> UTCTime -> ExceptT StoreError IO User
createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image, preferences = userPreferences} activeUser currentTs =
createUserRecordAt :: DB.Connection -> AgentUserId -> Profile -> Bool -> Bool -> UTCTime -> ExceptT StoreError IO User
createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image, preferences = userPreferences} userSuperpeer activeUser currentTs =
checkConstraint SEDuplicateName . liftIO $ do
when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0"
let showNtfs = True
@ -148,7 +148,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
(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 $ (userId, auId, contactId, profileId, BI activeUser, order, displayName, fullName, image, Nothing, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, Nothing, Nothing, Nothing, Nothing)
pure $ toUser $ (userId, auId, contactId, profileId, BI activeUser, order, displayName, fullName, image, Nothing, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, Nothing, Nothing, Nothing, Nothing, BI userSuperpeer)
-- TODO [mentions]
getUsersInfo :: DB.Connection -> IO [UserInfo]
@ -588,6 +588,49 @@ serverColumns p (ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_)
auth = safeDecodeUtf8 . unBasicAuth <$> auth_
in (protocol, host, port, keyHash, auth)
getSuperpeers :: DB.Connection -> User -> IO [UserSuperpeer]
getSuperpeers db User {userId} =
map toSuperpeer
<$> DB.query
db
[sql|
SELECT superpeer_id, address, name, domains, preset, tested, enabled
FROM superpeers
WHERE user_id = ?
|]
(Only userId)
where
toSuperpeer :: (DBEntityId, ConnReqContact, Text, Text, BoolInt, Maybe BoolInt, BoolInt) -> UserSuperpeer
toSuperpeer (superpeerId, address, name, domains, BI preset, tested, BI enabled) =
UserSuperpeer {superpeerId, address, name, domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted = False}
insertSuperpeer :: DB.Connection -> User -> UTCTime -> NewUserSuperpeer -> IO UserSuperpeer
insertSuperpeer db User {userId} ts speer@UserSuperpeer {address, name, domains, preset, tested, enabled} = do
sId <-
fromOnly . head
<$> DB.query
db
[sql|
INSERT INTO superpeers
(address, name, domains, preset, tested, enabled, user_id, created_at, updated_at)
VALUES (?,?,?,?,?,?,?,?,?)
RETURNING superpeer_id
|]
(address, name, T.intercalate "," domains, BI preset, BI <$> tested, BI enabled, userId, ts, ts)
pure speer {superpeerId = DBEntityId sId}
updateSuperpeer :: DB.Connection -> UTCTime -> UserSuperpeer -> IO ()
updateSuperpeer db ts UserSuperpeer {superpeerId, address, name, domains, preset, tested, enabled} =
DB.execute
db
[sql|
UPDATE superpeers
SET address = ?, name = ?, domains = ?,
preset = ?, tested = ?, enabled = ?, updated_at = ?
WHERE superpeer_id = ?
|]
(address, name, T.intercalate "," domains, BI preset, BI <$> tested, BI enabled, ts, superpeerId)
getServerOperators :: DB.Connection -> ExceptT StoreError IO ServerOperatorConditions
getServerOperators db = do
currentConditions <- getCurrentUsageConditions db
@ -599,12 +642,13 @@ getServerOperators db = do
let conditionsAction = usageConditionsAction ops currentConditions now
pure ServerOperatorConditions {serverOperators = ops, currentConditions, conditionsAction}
getUserServers :: DB.Connection -> User -> ExceptT StoreError IO ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
getUserServers :: DB.Connection -> User -> ExceptT StoreError IO ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserSuperpeer])
getUserServers db user =
(,,)
(,,,)
<$> (map Just . serverOperators <$> getServerOperators db)
<*> liftIO (getProtocolServers db SPSMP user)
<*> liftIO (getProtocolServers db SPXFTP user)
<*> liftIO (getSuperpeers db user)
setServerOperators :: DB.Connection -> NonEmpty ServerOperator -> IO ()
setServerOperators db ops = do
@ -817,20 +861,29 @@ setUserServers :: DB.Connection -> User -> UTCTime -> UpdatedUserOperatorServers
setUserServers db user ts = checkConstraint SEUniqueID . liftIO . setUserServers' db user ts
setUserServers' :: DB.Connection -> User -> UTCTime -> UpdatedUserOperatorServers -> IO UserOperatorServers
setUserServers' db user@User {userId} ts UpdatedUserOperatorServers {operator, smpServers, xftpServers} = do
setUserServers' db user@User {userId} ts UpdatedUserOperatorServers {operator, smpServers, xftpServers, superpeers} = do
mapM_ (updateServerOperator db ts) operator
smpSrvs' <- catMaybes <$> mapM (upsertOrDelete SPSMP) smpServers
xftpSrvs' <- catMaybes <$> mapM (upsertOrDelete SPXFTP) xftpServers
pure UserOperatorServers {operator, smpServers = smpSrvs', xftpServers = xftpSrvs'}
smpSrvs' <- catMaybes <$> mapM (upsertOrDeleteSrv SPSMP) smpServers
xftpSrvs' <- catMaybes <$> mapM (upsertOrDeleteSrv SPXFTP) xftpServers
speers' <- catMaybes <$> mapM upsertOrDeleteSpeer superpeers
pure UserOperatorServers {operator, smpServers = smpSrvs', xftpServers = xftpSrvs', superpeers = speers'}
where
upsertOrDelete :: ProtocolTypeI p => SProtocolType p -> AUserServer p -> IO (Maybe (UserServer p))
upsertOrDelete p (AUS _ s@UserServer {serverId, deleted}) = case serverId of
upsertOrDeleteSrv :: ProtocolTypeI p => SProtocolType p -> AUserServer p -> IO (Maybe (UserServer p))
upsertOrDeleteSrv p (AUS _ s@UserServer {serverId, deleted}) = case serverId of
DBNewEntity
| deleted -> pure Nothing
| otherwise -> Just <$> insertProtocolServer db p user ts s
DBEntityId srvId
| deleted -> Nothing <$ DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND smp_server_id = ? AND preset = ?" (userId, srvId, BI False)
| otherwise -> Just s <$ updateProtocolServer db p ts s
upsertOrDeleteSpeer :: AUserSuperpeer -> IO (Maybe UserSuperpeer)
upsertOrDeleteSpeer (AUSP _ speer@UserSuperpeer {superpeerId, deleted}) = case superpeerId of
DBNewEntity
| deleted -> pure Nothing
| otherwise -> Just <$> insertSuperpeer db user ts speer
DBEntityId speerId
| deleted -> Nothing <$ DB.execute db "DELETE FROM superpeers WHERE user_id = ? AND superpeer_id = ? AND preset = ?" (userId, speerId, BI False)
| otherwise -> Just speer <$ updateSuperpeer db ts speer
createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()
createCall db user@User {userId} Call {contactId, callId, callUUID, chatItemId, callState} callTs = do

View file

@ -128,6 +128,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20250122_chat_items_include_in_hist
import Simplex.Chat.Store.SQLite.Migrations.M20250126_mentions
import Simplex.Chat.Store.SQLite.Migrations.M20250129_delete_unused_contacts
import Simplex.Chat.Store.SQLite.Migrations.M20250130_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20250217_superpeers
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@ -255,7 +256,8 @@ schemaMigrations =
("20250122_chat_items_include_in_history", m20250122_chat_items_include_in_history, Just down_m20250122_chat_items_include_in_history),
("20250126_mentions", m20250126_mentions, Just down_m20250126_mentions),
("20250129_delete_unused_contacts", m20250129_delete_unused_contacts, Just down_m20250129_delete_unused_contacts),
("20250130_indexes", m20250130_indexes, Just down_m20250130_indexes)
("20250130_indexes", m20250130_indexes, Just down_m20250130_indexes),
("20250217_superpeers", m20250217_superpeers, Just down_m20250217_superpeers)
]
-- | The list of migrations in ascending order by date

View file

@ -0,0 +1,43 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20250217_superpeers where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20250217_superpeers :: Query
m20250217_superpeers =
[sql|
CREATE TABLE superpeers(
superpeer_id INTEGER PRIMARY KEY,
address TEXT NOT NULL,
name TEXT NOT NULL,
domains TEXT NOT NULL,
preset INTEGER NOT NULL DEFAULT 0,
tested INTEGER,
enabled INTEGER NOT NULL DEFAULT 1,
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now')),
UNIQUE(user_id, address),
UNIQUE(user_id, name)
);
CREATE INDEX idx_superpeers_user_id ON superpeers(user_id);
ALTER TABLE users ADD COLUMN user_superpeer INTEGER NOT NULL DEFAULT 0;
ALTER TABLE group_members ADD COLUMN superpeer INTEGER NOT NULL DEFAULT 0;
|]
down_m20250217_superpeers :: Query
down_m20250217_superpeers =
[sql|
ALTER TABLE group_members DROP COLUMN superpeer;
ALTER TABLE users DROP COLUMN user_superpeer;
DROP INDEX idx_superpeers_user_id;
DROP TABLE superpeers;
|]

View file

@ -39,11 +39,11 @@ Query:
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.member_restriction, mu.superpeer, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
@ -554,7 +554,7 @@ Query:
SELECT i.chat_item_id,
-- GroupMember
m.group_member_id, m.group_id, 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,
m.member_status, m.show_messages, m.member_restriction, m.superpeer, 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.image, p.contact_link, p.local_alias, p.preferences
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
@ -702,17 +702,17 @@ Query:
i.forwarded_by_group_member_id,
-- GroupMember
m.group_member_id, m.group_id, 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,
m.member_status, m.show_messages, m.member_restriction, m.superpeer, 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.image, p.contact_link, p.local_alias, p.preferences,
-- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
rm.member_status, rm.show_messages, rm.member_restriction, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rm.member_status, rm.show_messages, rm.member_restriction, rm.superpeer, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
-- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.superpeer, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
@ -787,11 +787,11 @@ Query:
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.member_restriction, mu.superpeer, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- via GroupMember
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences,
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.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.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
@ -828,7 +828,7 @@ Query:
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction, mu.superpeer,
mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
JOIN group_profiles gp USING (group_profile_id)
@ -1266,10 +1266,10 @@ Plan:
Query:
INSERT INTO group_members
(group_id, member_id, member_role, member_category, member_status, member_restriction, invited_by, invited_by_group_member_id,
(group_id, member_id, member_role, member_category, member_status, member_restriction, superpeer, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
@ -3282,6 +3282,14 @@ Query:
Plan:
SEARCH protocol_servers USING INDEX idx_smp_servers_user_id (user_id=?)
Query:
SELECT superpeer_id, address, name, domains, preset, tested, enabled
FROM superpeers
WHERE user_id = ?
Plan:
SEARCH superpeers USING INDEX idx_superpeers_user_id (user_id=?)
Query:
SELECT to_group_member_id
FROM group_member_intros
@ -4414,7 +4422,7 @@ Query:
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.member_restriction, mu.superpeer, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
@ -4435,7 +4443,7 @@ Query:
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.member_restriction, mu.superpeer, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
@ -4450,7 +4458,7 @@ SEARCH pu USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences,
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.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.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
@ -4481,7 +4489,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group
Query:
SELECT
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences,
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.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.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
@ -4504,7 +4512,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group
Query:
SELECT
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences,
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.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.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
@ -4527,7 +4535,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group
Query:
SELECT
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences,
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.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.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
@ -4550,7 +4558,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group
Query:
SELECT
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences,
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.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.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
@ -4573,7 +4581,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group
Query:
SELECT
m.group_member_id, m.group_id, 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.group_member_id, m.group_id, 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.superpeer,
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.image, p.contact_link, p.local_alias, p.preferences,
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.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.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
@ -4710,7 +4718,7 @@ 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.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.user_superpeer
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
@ -4722,7 +4730,7 @@ 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.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.user_superpeer
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
@ -4735,7 +4743,7 @@ 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.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.user_superpeer
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
@ -4748,7 +4756,7 @@ 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.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.user_superpeer
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
@ -4761,7 +4769,7 @@ 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.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.user_superpeer
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
@ -4775,7 +4783,7 @@ 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.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.user_superpeer
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
@ -4788,7 +4796,7 @@ 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.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.user_superpeer
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
@ -4801,7 +4809,7 @@ 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.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.user_superpeer
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
@ -4814,7 +4822,7 @@ 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.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.user_superpeer
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
@ -4827,7 +4835,7 @@ 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.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.user_superpeer
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
@ -5203,6 +5211,7 @@ SEARCH connections USING COVERING INDEX idx_connections_user_contact_link_id (us
Query: DELETE FROM users WHERE user_id = ?
Plan:
SEARCH users USING INTEGER PRIMARY KEY (rowid=?)
SEARCH superpeers USING COVERING INDEX idx_superpeers_user_id (user_id=?)
SEARCH chat_tags USING COVERING INDEX idx_chat_tags_user_id (user_id=?)
SEARCH note_folders USING COVERING INDEX note_folders_user_id (user_id=?)
SEARCH received_probes USING COVERING INDEX idx_received_probes_user_id (user_id=?)

View file

@ -36,7 +36,8 @@ CREATE TABLE users(
send_rcpts_small_groups INTEGER NOT NULL DEFAULT 0,
user_member_profile_updated_at TEXT,
ui_themes TEXT,
active_order INTEGER NOT NULL DEFAULT 0, -- 1 for active user
active_order INTEGER NOT NULL DEFAULT 0,
user_superpeer INTEGER NOT NULL DEFAULT 0, -- 1 for active user
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE RESTRICT
@ -166,6 +167,7 @@ CREATE TABLE group_members(
peer_chat_min_version INTEGER NOT NULL DEFAULT 1,
peer_chat_max_version INTEGER NOT NULL DEFAULT 1,
member_restriction TEXT,
superpeer INTEGER NOT NULL DEFAULT 0,
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
@ -649,6 +651,20 @@ CREATE TABLE chat_item_mentions(
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
display_name TEXT NOT NULL
);
CREATE TABLE superpeers(
superpeer_id INTEGER PRIMARY KEY,
address TEXT NOT NULL,
name TEXT NOT NULL,
domains TEXT NOT NULL,
preset INTEGER NOT NULL DEFAULT 0,
tested INTEGER,
enabled INTEGER NOT NULL DEFAULT 1,
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now')),
UNIQUE(user_id, address),
UNIQUE(user_id, name)
);
CREATE INDEX contact_profiles_index ON contact_profiles(
display_name,
full_name
@ -1018,3 +1034,4 @@ CREATE INDEX idx_chat_items_group_id_shared_msg_id ON chat_items(
group_id,
shared_msg_id
);
CREATE INDEX idx_superpeers_user_id ON superpeers(user_id);

View file

@ -456,15 +456,15 @@ 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.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes, u.user_superpeer
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
|]
toUser :: (UserId, UserId, ContactId, ProfileId, BoolInt, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, Maybe UIThemeEntityOverrides) -> User
toUser ((userId, auId, userContactId, profileId, BI activeUser, activeOrder, displayName, fullName, image, contactLink, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, uiThemes)) =
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash, userMemberProfileUpdatedAt, uiThemes}
toUser :: (UserId, UserId, ContactId, ProfileId, BoolInt, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, Maybe UIThemeEntityOverrides, BoolInt) -> User
toUser ((userId, auId, userContactId, profileId, BI activeUser, activeOrder, displayName, fullName, image, contactLink, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, uiThemes, BI userSuperpeer)) =
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash, userMemberProfileUpdatedAt, uiThemes, userSuperpeer}
where
profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences = userPreferences, localAlias = ""}
fullPreferences = mergePreferences Nothing userPreferences
@ -579,7 +579,7 @@ type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe Member
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Text, Maybe Text, Maybe ImageData, Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. BusinessChatInfoRow :. (Maybe UIThemeEntityOverrides, Maybe CustomData, Maybe Int64) :. GroupMemberRow
type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus, BoolInt) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, localAlias, description, image, enableNtfs_, sendRcpts, BI favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. businessRow :. (uiThemes, customData, chatItemTTL) :. userMemberRow) =
@ -591,7 +591,7 @@ toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName,
in GroupInfo {groupId, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, chatTags, chatItemTTL, uiThemes, customData}
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_, BI superpeer) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
let memberProfile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
memberSettings = GroupMemberSettings {showMessages}
blockedByAdmin = maybe False mrsBlocked memberRestriction_
@ -614,7 +614,7 @@ groupInfoQuery =
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
mu.member_status, mu.show_messages, mu.member_restriction, mu.superpeer, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id

View file

@ -9,7 +9,7 @@ module Simplex.Chat.Terminal where
import Control.Monad
import qualified Data.List.NonEmpty as L
import Simplex.Chat (defaultChatConfig, operatorSimpleXChat)
import Simplex.Chat (defaultChatConfig, operatorSimpleXChat, simplexChatSuperpeers)
import Simplex.Chat.Controller
import Simplex.Chat.Core
import Simplex.Chat.Help (chatWelcome)
@ -49,7 +49,9 @@ terminalChatConfig =
],
useSMP = 3,
xftp = map (presetServer True) $ L.toList defaultXFTPServers,
useXFTP = 3
useXFTP = 3,
superpeers = simplexChatSuperpeers,
useSuperpeers = 2
}
],
ntf = _defaultNtfServers,

View file

@ -115,6 +115,7 @@ instance ToField AgentUserId where toField (AgentUserId uId) = toField uId
aUserId :: User -> UserId
aUserId User {agentUserId = AgentUserId uId} = uId
-- TODO [superpeers] filter out superpeer users where necessary (e.g. loading list of users for UI)
data User = User
{ userId :: UserId,
agentUserId :: AgentUserId,
@ -129,13 +130,15 @@ data User = User
sendRcptsContacts :: Bool,
sendRcptsSmallGroups :: Bool,
userMemberProfileUpdatedAt :: Maybe UTCTime,
uiThemes :: Maybe UIThemeEntityOverrides
uiThemes :: Maybe UIThemeEntityOverrides,
userSuperpeer :: Bool
}
deriving (Show)
data NewUser = NewUser
{ profile :: Maybe Profile,
pastTimestamp :: Bool
pastTimestamp :: Bool,
userSuperpeer :: Bool
}
deriving (Show)
@ -784,7 +787,8 @@ data GroupMember = GroupMember
-- member chat protocol version range; if member has active connection, its version range is preferred;
-- for membership current supportedChatVRange is set, it's not updated on protocol version increase in database,
-- but it's correctly set on read (see toGroupInfo)
memberChatVRange :: VersionRangeChat
memberChatVRange :: VersionRangeChat,
superpeer :: Bool
}
deriving (Eq, Show)
@ -839,7 +843,8 @@ data NewGroupMember = NewGroupMember
memInvitedByGroupMemberId :: Maybe GroupMemberId,
localDisplayName :: ContactName,
memProfileId :: Int64,
memContactId :: Maybe Int64
memContactId :: Maybe Int64,
superpeer :: Bool
}
newtype MemberId = MemberId {unMemberId :: ByteString}

View file

@ -100,7 +100,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [viewJSON chats]
CRChats chats -> viewChats ts tz chats
CRApiChat u chat _ -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat]
CRChatTags u tags -> ttyUser u $ [viewJSON tags]
CRChatTags u tags -> ttyUser u [viewJSON tags]
CRApiParsedMarkdown ft -> [viewJSON ft]
CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure
CRServerOperatorConditions (ServerOperatorConditions ops _ ca) -> viewServerOperators ops ca
@ -1244,11 +1244,12 @@ viewUserPrivacy User {userId} User {userId = userId', localDisplayName = n', sho
]
viewUserServers :: UserOperatorServers -> [StyledString]
viewUserServers (UserOperatorServers _ [] []) = []
viewUserServers UserOperatorServers {operator, smpServers, xftpServers} =
viewUserServers (UserOperatorServers _ [] [] []) = []
viewUserServers UserOperatorServers {operator, smpServers, xftpServers, superpeers} =
[plain $ maybe "Your servers" shortViewOperator operator]
<> viewServers SPSMP smpServers
<> viewServers SPXFTP xftpServers
<> viewSuperpeers superpeers
where
viewServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [UserServer p] -> [StyledString]
viewServers _ [] = []
@ -1271,6 +1272,19 @@ viewUserServers UserOperatorServers {operator, smpServers, xftpServers} =
| otherwise = "disabled (servers known)"
where
rs = operatorRoles p op
viewSuperpeers :: [UserSuperpeer] -> [StyledString]
viewSuperpeers [] = []
viewSuperpeers speers
| maybe True (\ServerOperator {enabled} -> enabled) operator =
["Superpeers"] <> map (plain . (" " <>) . viewSuperpeer) speers
| otherwise = []
where
viewSuperpeer UserSuperpeer {name, address, preset, tested, enabled} = name <> superpeerAddress <> superpeerInfo
where
superpeerAddress = "(" <> safeDecodeUtf8 (strEncode address) <> ")"
superpeerInfo = if null superpeerInfo_ then "" else parens $ T.intercalate ", " superpeerInfo_
superpeerInfo_ = ["preset" | preset] <> testedInfo <> ["disabled" | not enabled]
testedInfo = maybe [] (\t -> ["test: " <> if t then "passed" else "failed"]) tested
serversUserHelp :: [StyledString]
serversUserHelp =
@ -2108,6 +2122,7 @@ viewChatError isCmd logLevel testView = \case
CENoRcvFileUser aFileId -> ["error: rcv file user not found, file id: " <> sShow aFileId | logLevel <= CLLError]
CEActiveUserExists -> ["error: active user already exists"]
CEUserExists name -> ["user with the name " <> ttyContact name <> " already exists"]
CESuperpeerExists -> ["superpeer user already exists"]
CEUserUnknown -> ["user does not exist or incorrect password"]
CEDifferentActiveUser commandUserId activeUserId -> ["error: different active user, command user id: " <> sShow commandUserId <> ", active user id: " <> sShow activeUserId]
CECantDeleteActiveUser _ -> ["cannot delete active user"]

View file

@ -258,7 +258,7 @@ createTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> Profile -> I
createTestChat ps cfg opts@ChatOpts {coreOptions} dbPrefix profile = do
Right db@ChatDatabase {chatStore, agentStore} <- createDatabase ps coreOptions dbPrefix
insertUser agentStore
Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile True
Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile False True
startTestChat_ ps db cfg opts user
startTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> IO TestCC

View file

@ -11,16 +11,16 @@ noActiveUserTagged :: LB.ByteString
noActiveUserTagged = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"noActiveUser\"}}}}"
activeUserExistsSwift :: LB.ByteString
activeUserExistsSwift = "{\"resp\":{\"_owsf\":true,\"chatCmdError\":{\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true},\"chatError\":{\"_owsf\":true,\"error\":{\"errorType\":{\"_owsf\":true,\"userExists\":{\"contactName\":\"alice\"}}}}}}}"
activeUserExistsSwift = "{\"resp\":{\"_owsf\":true,\"chatCmdError\":{\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true,\"userSuperpeer\":false},\"chatError\":{\"_owsf\":true,\"error\":{\"errorType\":{\"_owsf\":true,\"userExists\":{\"contactName\":\"alice\"}}}}}}}"
activeUserExistsTagged :: LB.ByteString
activeUserExistsTagged = "{\"resp\":{\"type\":\"chatCmdError\",\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true},\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"userExists\",\"contactName\":\"alice\"}}}}"
activeUserExistsTagged = "{\"resp\":{\"type\":\"chatCmdError\",\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true,\"userSuperpeer\":false},\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"userExists\",\"contactName\":\"alice\"}}}}"
activeUserSwift :: LB.ByteString
activeUserSwift = "{\"resp\":{\"_owsf\":true,\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true}}}}"
activeUserSwift = "{\"resp\":{\"_owsf\":true,\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true,\"userSuperpeer\":false}}}}"
activeUserTagged :: LB.ByteString
activeUserTagged = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true}}}"
activeUserTagged = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true,\"userSuperpeer\":false}}}"
chatStartedSwift :: LB.ByteString
chatStartedSwift = "{\"resp\":{\"_owsf\":true,\"chatStarted\":{}}}"
@ -35,7 +35,7 @@ networkStatusesTagged :: LB.ByteString
networkStatusesTagged = "{\"resp\":{\"type\":\"networkStatuses\",\"user_\":" <> userJSON <> ",\"networkStatuses\":[]}}"
userJSON :: LB.ByteString
userJSON = "{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true}"
userJSON = "{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"activeOrder\":1,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true,\"userSuperpeer\":false}"
memberSubSummarySwift :: LB.ByteString
memberSubSummarySwift = "{\"resp\":{\"_owsf\":true,\"memberSubSummary\":{\"user\":" <> userJSON <> ",\"memberSubscriptions\":[]}}}"

View file

@ -165,7 +165,7 @@ testChatApi ps = do
dbPrefix = tmp </> "1"
f = dbPrefix <> chatSuffix
Right st <- createChatStore (DBOpts f "myKey" False True DB.TQOff) MCYesUp
Right _ <- withTransaction st $ \db -> runExceptT $ createUserRecord db (AgentUserId 1) aliceProfile {preferences = Nothing} True
Right _ <- withTransaction st $ \db -> runExceptT $ createUserRecord db (AgentUserId 1) aliceProfile {preferences = Nothing} False True
Right cc <- chatMigrateInit dbPrefix "myKey" "yesUp"
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "" "yesUp"
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "anotherKey" "yesUp"

View file

@ -22,6 +22,7 @@ import Simplex.Chat.Operators
import Simplex.Chat.Types
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..), allRoles)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol
import Test.Hspec
@ -32,18 +33,36 @@ operatorTests = describe "managing server operators" $ do
validateServersTest :: Spec
validateServersTest = describe "validate user servers" $ do
it "should pass valid user servers" $ validateUserServers [valid] [] `shouldBe` []
it "should pass valid user servers" $ validateUserServers [valid] [] `shouldBe` ([], [])
it "should fail without servers" $ do
validateUserServers [invalidNoServers] [] `shouldBe` [USENoServers aSMP Nothing]
validateUserServers [invalidDisabled] [] `shouldBe` [USENoServers aSMP Nothing]
validateUserServers [invalidDisabledOp] [] `shouldBe` [USENoServers aSMP Nothing, USENoServers aXFTP Nothing]
validateUserServers [invalidNoServers] [] `shouldBe` ([USENoServers aSMP Nothing], [])
validateUserServers [invalidDisabled] [] `shouldBe` ([USENoServers aSMP Nothing], [])
validateUserServers [invalidDisabledOp] [] `shouldBe` ([USENoServers aSMP Nothing, USENoServers aXFTP Nothing], [USWNoSuperpeers Nothing])
it "should fail without servers with storage role" $ do
validateUserServers [invalidNoStorage] [] `shouldBe` [USEStorageMissing aSMP Nothing]
validateUserServers [invalidNoStorage] [] `shouldBe` ([USEStorageMissing aSMP Nothing], [])
it "should fail with duplicate host" $ do
validateUserServers [invalidDuplicate] [] `shouldBe`
[ USEDuplicateServer aSMP "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion" "smp8.simplex.im",
USEDuplicateServer aSMP "smp://abcd@smp8.simplex.im" "smp8.simplex.im"
]
validateUserServers [invalidDuplicateSrv] []
`shouldBe` ( [ USEDuplicateServer aSMP "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion" "smp8.simplex.im",
USEDuplicateServer aSMP "smp://abcd@smp8.simplex.im" "smp8.simplex.im"
],
[]
)
it "should warn without superpeers" $
validateUserServers [invalidNoSuperpeers] [] `shouldBe` ([], [USWNoSuperpeers Nothing])
it "should fail with duplicate superpeer name" $ do
validateUserServers [invalidDuplicateSpeerName] []
`shouldBe` ( [ USEDuplicateSuperpeerName "superpeer1",
USEDuplicateSuperpeerName "superpeer1"
],
[]
)
it "should fail with duplicate superpeer address" $ do
validateUserServers [invalidDuplicateSpeerAddress] []
`shouldBe` ( [ USEDuplicateSuperpeerAddress "superpeer1" duplicateAddr,
USEDuplicateSuperpeerAddress "superpeer4" duplicateAddr
],
[]
)
where
aSMP = AProtocolType SPSMP
aXFTP = AProtocolType SPXFTP
@ -57,7 +76,7 @@ updatedServersTest = describe "validate user servers" $ do
all addedPreset ops' `shouldBe` True
let ops'' :: [(Maybe PresetOperator, Maybe ServerOperator)] =
saveOps ops' -- mock getUpdateServerOperators
uss <- groupByOperator' (ops'', [], []) -- no stored servers
uss <- groupByOperator' (ops'', [], [], []) -- no stored servers
length uss `shouldBe` 3
[op1, op2, op3] <- pure $ map updatedUserServers uss
[p1, p2] <- pure operators -- presets
@ -65,14 +84,15 @@ updatedServersTest = describe "validate user servers" $ do
sameServers p2 op2
null (servers' SPSMP op3) `shouldBe` True
null (servers' SPXFTP op3) `shouldBe` True
it "adding preset operators and assiging servers to operator for existing users" $ do
it "adding preset operators and assigning servers to operator for existing users" $ do
let ops' = updatedServerOperators operators []
ops'' = saveOps ops'
uss <-
groupByOperator'
( ops'',
saveSrvs $ take 3 simplexChatSMPServers <> [newUserServer "smp://abcd@smp.example.im"],
saveSrvs $ map (presetServer True) $ L.take 3 defaultXFTPServers
saveSrvs $ map (presetServer True) $ L.take 3 defaultXFTPServers,
[]
)
[op1, op2, op3] <- pure $ map updatedUserServers uss
[p1, p2] <- pure operators -- presets
@ -84,8 +104,8 @@ updatedServersTest = describe "validate user servers" $ do
addedPreset = \case
(Just PresetOperator {operator = Just op}, Just (ASO SDBNew op')) -> operatorTag op == operatorTag op'
_ -> False
saveOps = zipWith (\i -> second ((\(ASO _ op) -> op {operatorId = DBEntityId i}) <$>)) [1..]
saveSrvs = zipWith (\i srv -> srv {serverId = DBEntityId i}) [1..]
saveOps = zipWith (\i -> second ((\(ASO _ op) -> op {operatorId = DBEntityId i}) <$>)) [1 ..]
saveSrvs = zipWith (\i srv -> srv {serverId = DBEntityId i}) [1 ..]
sameServers preset op = do
map srvHost (pServers SPSMP preset) `shouldBe` map srvHost' (servers' SPSMP op)
map srvHost (pServers SPXFTP preset) `shouldBe` map srvHost' (servers' SPXFTP op)
@ -96,12 +116,15 @@ deriving instance Eq User
deriving instance Eq UserServersError
deriving instance Eq UserServersWarning
valid :: UpdatedUserOperatorServers
valid =
UpdatedUserOperatorServers
{ operator = Just operatorSimpleXChat {operatorId = DBEntityId 1},
smpServers = map (AUS SDBNew) simplexChatSMPServers,
xftpServers = map (AUS SDBNew . presetServer True) $ L.toList defaultXFTPServers
xftpServers = map (AUS SDBNew . presetServer True) $ L.toList defaultXFTPServers,
superpeers = map (AUSP SDBNew) simplexChatSuperpeers
}
invalidNoServers :: UpdatedUserOperatorServers
@ -125,8 +148,26 @@ invalidNoStorage =
{ operator = Just operatorSimpleXChat {operatorId = DBEntityId 1, smpRoles = allRoles {storage = False}}
}
invalidDuplicate :: UpdatedUserOperatorServers
invalidDuplicate =
invalidDuplicateSrv :: UpdatedUserOperatorServers
invalidDuplicateSrv =
(valid :: UpdatedUserOperatorServers)
{ smpServers = map (AUS SDBNew) $ simplexChatSMPServers <> [presetServer True "smp://abcd@smp8.simplex.im"]
}
invalidNoSuperpeers :: UpdatedUserOperatorServers
invalidNoSuperpeers = (valid :: UpdatedUserOperatorServers) {superpeers = []}
invalidDuplicateSpeerName :: UpdatedUserOperatorServers
invalidDuplicateSpeerName =
(valid :: UpdatedUserOperatorServers)
{ superpeers = map (AUSP SDBNew) $ simplexChatSuperpeers <> [presetSuperpeer True "superpeer1" ["simplex.im"] (either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp444.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D")]
}
invalidDuplicateSpeerAddress :: UpdatedUserOperatorServers
invalidDuplicateSpeerAddress =
(valid :: UpdatedUserOperatorServers)
{ superpeers = map (AUSP SDBNew) $ simplexChatSuperpeers <> [presetSuperpeer True "superpeer4" ["simplex.im"] duplicateAddr]
}
duplicateAddr :: ConnReqContact
duplicateAddr = either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp111.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D"