mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-09-17 01:35:08 +00:00
core: update simplexmq (receiving services) (#6212)
* core: update simplexmq * update agent api * update simplexmq * core: add flag to User to use client services * update simplexmq * cli command to toggle service for a user * test, fix * query plans, core/bot api types * remove local package reference * increase server queue size in tests * show client service status in users list * update query plans * cli: fix redraw slowness (#6735) * cli: add pland to fix redraw slowness * updtae doc * cli: decouple key reading from processing via TQueue * schema and bot types --------- Co-authored-by: sh <37271604+shumvgolove@users.noreply.github.com>
This commit is contained in:
+88
-86
@@ -135,7 +135,7 @@ createChatDatabase chatDbOpts migrationConfig = runExceptT $ do
|
||||
agentStore <- ExceptT $ createAgentStore (toDBOpts chatDbOpts agentSuffix False []) migrationConfig
|
||||
pure ChatDatabase {chatStore, agentStore}
|
||||
|
||||
newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Bool -> IO ChatController
|
||||
newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Bool -> IO (Either AgentErrorType ChatController)
|
||||
newChatController
|
||||
ChatDatabase {chatStore, agentStore}
|
||||
user
|
||||
@@ -145,8 +145,6 @@ newChatController
|
||||
let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
|
||||
confirmMigrations' = if confirmMigrations == MCConsole && yesToUpMigrations then MCYesUp else confirmMigrations
|
||||
config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, presetServers = presetServers', inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable, confirmMigrations = confirmMigrations'}
|
||||
firstTime = dbNew chatStore
|
||||
currentUser <- newTVarIO user
|
||||
randomPresetServers <- chooseRandomServers presetServers'
|
||||
let rndSrvs = L.toList randomPresetServers
|
||||
operatorWithId (i, op) = (\o -> o {operatorId = DBEntityId i}) <$> pOperator op
|
||||
@@ -154,90 +152,93 @@ newChatController
|
||||
agentSMP <- randomServerCfgs "agent SMP servers" SPSMP opDomains rndSrvs
|
||||
agentXFTP <- randomServerCfgs "agent XFTP servers" SPXFTP opDomains rndSrvs
|
||||
let randomAgentServers = RandomAgentServers {smpServers = agentSMP, xftpServers = agentXFTP}
|
||||
currentRemoteHost <- newTVarIO Nothing
|
||||
servers <- withTransaction chatStore $ \db -> agentServers db config randomPresetServers randomAgentServers
|
||||
smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore backgroundMode
|
||||
agentAsync <- newTVarIO Nothing
|
||||
random <- liftIO C.newRandom
|
||||
eventSeq <- newTVarIO 0
|
||||
inputQ <- newTBQueueIO tbqSize
|
||||
outputQ <- newTBQueueIO tbqSize
|
||||
subscriptionMode <- newTVarIO SMSubscribe
|
||||
chatLock <- newEmptyTMVarIO
|
||||
entityLocks <- TM.emptyIO
|
||||
sndFiles <- newTVarIO M.empty
|
||||
rcvFiles <- newTVarIO M.empty
|
||||
currentCalls <- TM.emptyIO
|
||||
localDeviceName <- newTVarIO $ fromMaybe deviceNameForRemote deviceName
|
||||
multicastSubscribers <- newTMVarIO 0
|
||||
remoteSessionSeq <- newTVarIO 0
|
||||
remoteHostSessions <- TM.emptyIO
|
||||
remoteHostsFolder <- newTVarIO Nothing
|
||||
remoteCtrlSession <- newTVarIO Nothing
|
||||
filesFolder <- newTVarIO optFilesFolder
|
||||
chatStoreChanged <- newTVarIO False
|
||||
deliveryTaskWorkers <- TM.emptyIO
|
||||
deliveryJobWorkers <- TM.emptyIO
|
||||
relayRequestWorkers <- TM.emptyIO
|
||||
chatRelayTests <- TM.emptyIO
|
||||
expireCIThreads <- TM.emptyIO
|
||||
expireCIFlags <- TM.emptyIO
|
||||
cleanupManagerAsync <- newTVarIO Nothing
|
||||
relayGroupLinkChecksAsync <- newTVarIO Nothing
|
||||
timedItemThreads <- TM.emptyIO
|
||||
chatActivated <- newTVarIO True
|
||||
showLiveItems <- newTVarIO False
|
||||
encryptLocalFiles <- newTVarIO False
|
||||
tempDirectory <- newTVarIO optTempDirectory
|
||||
assetsDirectory <- newTVarIO Nothing
|
||||
contactMergeEnabled <- newTVarIO True
|
||||
pure
|
||||
ChatController
|
||||
{ firstTime,
|
||||
currentUser,
|
||||
randomPresetServers,
|
||||
randomAgentServers,
|
||||
currentRemoteHost,
|
||||
smpAgent,
|
||||
agentAsync,
|
||||
chatStore,
|
||||
chatStoreChanged,
|
||||
random,
|
||||
eventSeq,
|
||||
inputQ,
|
||||
outputQ,
|
||||
subscriptionMode,
|
||||
chatLock,
|
||||
entityLocks,
|
||||
sndFiles,
|
||||
rcvFiles,
|
||||
currentCalls,
|
||||
localDeviceName,
|
||||
multicastSubscribers,
|
||||
remoteSessionSeq,
|
||||
remoteHostSessions,
|
||||
remoteHostsFolder,
|
||||
remoteCtrlSession,
|
||||
config,
|
||||
filesFolder,
|
||||
deliveryTaskWorkers,
|
||||
deliveryJobWorkers,
|
||||
relayRequestWorkers,
|
||||
chatRelayTests,
|
||||
expireCIThreads,
|
||||
expireCIFlags,
|
||||
cleanupManagerAsync,
|
||||
relayGroupLinkChecksAsync,
|
||||
timedItemThreads,
|
||||
chatActivated,
|
||||
showLiveItems,
|
||||
encryptLocalFiles,
|
||||
tempDirectory,
|
||||
assetsDirectory,
|
||||
logFilePath = logFile,
|
||||
contactMergeEnabled
|
||||
}
|
||||
runExceptT (getSMPAgentClient aCfg {tbqSize} servers agentStore backgroundMode)
|
||||
>>= mapM (mkChatController config randomPresetServers randomAgentServers)
|
||||
where
|
||||
mkChatController config randomPresetServers randomAgentServers smpAgent = do
|
||||
currentUser <- newTVarIO user
|
||||
currentRemoteHost <- newTVarIO Nothing
|
||||
agentAsync <- newTVarIO Nothing
|
||||
random <- liftIO C.newRandom
|
||||
eventSeq <- newTVarIO 0
|
||||
inputQ <- newTBQueueIO tbqSize
|
||||
outputQ <- newTBQueueIO tbqSize
|
||||
subscriptionMode <- newTVarIO SMSubscribe
|
||||
chatLock <- newEmptyTMVarIO
|
||||
entityLocks <- TM.emptyIO
|
||||
sndFiles <- newTVarIO M.empty
|
||||
rcvFiles <- newTVarIO M.empty
|
||||
currentCalls <- TM.emptyIO
|
||||
localDeviceName <- newTVarIO $ fromMaybe deviceNameForRemote deviceName
|
||||
multicastSubscribers <- newTMVarIO 0
|
||||
remoteSessionSeq <- newTVarIO 0
|
||||
remoteHostSessions <- TM.emptyIO
|
||||
remoteHostsFolder <- newTVarIO Nothing
|
||||
remoteCtrlSession <- newTVarIO Nothing
|
||||
filesFolder <- newTVarIO optFilesFolder
|
||||
chatStoreChanged <- newTVarIO False
|
||||
deliveryTaskWorkers <- TM.emptyIO
|
||||
deliveryJobWorkers <- TM.emptyIO
|
||||
relayRequestWorkers <- TM.emptyIO
|
||||
relayGroupLinkChecksAsync <- newTVarIO Nothing
|
||||
chatRelayTests <- TM.emptyIO
|
||||
expireCIThreads <- TM.emptyIO
|
||||
expireCIFlags <- TM.emptyIO
|
||||
cleanupManagerAsync <- newTVarIO Nothing
|
||||
timedItemThreads <- TM.emptyIO
|
||||
chatActivated <- newTVarIO True
|
||||
showLiveItems <- newTVarIO False
|
||||
encryptLocalFiles <- newTVarIO False
|
||||
tempDirectory <- newTVarIO optTempDirectory
|
||||
assetsDirectory <- newTVarIO Nothing
|
||||
contactMergeEnabled <- newTVarIO True
|
||||
pure
|
||||
ChatController
|
||||
{ firstTime = dbNew chatStore,
|
||||
currentUser,
|
||||
randomPresetServers,
|
||||
randomAgentServers,
|
||||
currentRemoteHost,
|
||||
smpAgent,
|
||||
agentAsync,
|
||||
chatStore,
|
||||
chatStoreChanged,
|
||||
random,
|
||||
eventSeq,
|
||||
inputQ,
|
||||
outputQ,
|
||||
subscriptionMode,
|
||||
chatLock,
|
||||
entityLocks,
|
||||
sndFiles,
|
||||
rcvFiles,
|
||||
currentCalls,
|
||||
localDeviceName,
|
||||
multicastSubscribers,
|
||||
remoteSessionSeq,
|
||||
remoteHostSessions,
|
||||
remoteHostsFolder,
|
||||
remoteCtrlSession,
|
||||
config,
|
||||
filesFolder,
|
||||
deliveryTaskWorkers,
|
||||
deliveryJobWorkers,
|
||||
relayRequestWorkers,
|
||||
relayGroupLinkChecksAsync,
|
||||
chatRelayTests,
|
||||
expireCIThreads,
|
||||
expireCIFlags,
|
||||
cleanupManagerAsync,
|
||||
timedItemThreads,
|
||||
chatActivated,
|
||||
showLiveItems,
|
||||
encryptLocalFiles,
|
||||
tempDirectory,
|
||||
assetsDirectory,
|
||||
logFilePath = logFile,
|
||||
contactMergeEnabled
|
||||
}
|
||||
presetServers' :: PresetServers
|
||||
presetServers' = presetServers {operators = operators', netCfg = netCfg'}
|
||||
where
|
||||
@@ -271,7 +272,8 @@ newChatController
|
||||
ops <- getUpdateServerOperators db presetOps (null users)
|
||||
let opDomains = operatorDomains $ mapMaybe snd ops
|
||||
(smp', xftp') <- unzip <$> mapM (getServers ops opDomains) users
|
||||
pure InitialAgentServers {smp = M.fromList (optServers smp' smpServers), xftp = M.fromList (optServers xftp' xftpServers), ntf, netCfg, presetDomains, presetServers = L.toList allPresetServers}
|
||||
let useServices = M.fromList $ map (\User {agentUserId = AgentUserId uId, clientService} -> (uId, isTrue clientService)) users
|
||||
pure InitialAgentServers {smp = M.fromList (optServers smp' smpServers), xftp = M.fromList (optServers xftp' xftpServers), ntf, netCfg, useServices, presetDomains, presetServers = L.toList allPresetServers}
|
||||
where
|
||||
optServers :: [(UserId, NonEmpty (ServerCfg p))] -> [ProtoServerWithAuth p] -> [(UserId, NonEmpty (ServerCfg p))]
|
||||
optServers srvs overrides_ = case L.nonEmpty overrides_ of
|
||||
|
||||
Reference in New Issue
Block a user