mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
core: superpeers data model first draft (#5641)
This commit is contained in:
parent
704bab171d
commit
f0918a8e9d
24 changed files with 533 additions and 159 deletions
|
@ -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:
|
||||
|
|
|
@ -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'
|
||||
|
|
|
@ -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}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|]
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|]
|
|
@ -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=?)
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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}
|
||||
|
|
|
@ -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"]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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\":[]}}}"
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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"
|
||||
|
|
Loading…
Add table
Reference in a new issue