core: fix preset relays population (#6707)

This commit is contained in:
spaced4ndy
2026-03-25 17:48:19 +00:00
committed by GitHub
parent 3d6f1e8579
commit b680320dee
2 changed files with 37 additions and 7 deletions
+23 -5
View File
@@ -390,13 +390,14 @@ 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', chatRelays = []}
updatedUserServers (presetOp_, UserOperatorServers {operator, smpServers, xftpServers, chatRelays}) =
UpdatedUserOperatorServers {operator, smpServers = smp', xftpServers = xftp', chatRelays = cRelays'}
where
stored = map (AUS SDBStored)
(smp', xftp') = case presetOp_ of
Nothing -> (stored smpServers, stored xftpServers)
Just presetOp -> (updated SPSMP smpServers, updated SPXFTP xftpServers)
storedRelays = map (AUCR SDBStored)
(smp', xftp', cRelays') = case presetOp_ of
Nothing -> (stored smpServers, stored xftpServers, storedRelays chatRelays)
Just presetOp -> (updated SPSMP smpServers, updated SPXFTP xftpServers, updatedRelays chatRelays)
where
updated :: forall p. UserProtocol p => SProtocolType p -> [UserServer p] -> [AUserServer p]
updated p srvs = map userServer presetSrvs <> stored (filter customServer srvs)
@@ -411,10 +412,27 @@ updatedUserServers (presetOp_, UserOperatorServers {operator, smpServers, xftpSe
presetHosts = foldMap' (S.fromList . L.toList . srvHost) presetSrvs
userServer :: NewUserServer p -> AUserServer p
userServer srv@UserServer {server} = maybe (AUS SDBNew srv) (AUS SDBStored) (M.lookup server storedSrvs)
updatedRelays :: [UserChatRelay] -> [AUserChatRelay]
updatedRelays relays = map userRelay presetRelays <> storedRelays (filter customRelay relays)
where
customRelay :: UserChatRelay -> Bool
customRelay UserChatRelay {preset, address} =
not preset && not (any (sameShortLinkContact address . chatRelayAddress) presetRelays)
presetRelays :: [NewUserChatRelay]
presetRelays =
let PresetOperator {chatRelays = crs} = presetOp
in crs
userRelay :: NewUserChatRelay -> AUserChatRelay
userRelay relay@UserChatRelay {address} =
maybe (AUCR SDBNew relay) (AUCR SDBStored) $
find (sameShortLinkContact address . chatRelayAddress) relays
srvHost :: UserServer' s p -> NonEmpty TransportHost
srvHost UserServer {server = ProtoServerWithAuth srv _} = host srv
chatRelayAddress :: UserChatRelay' s -> ShortLinkContact
chatRelayAddress UserChatRelay {address} = address
agentServerCfgs :: UserProtocol p => SProtocolType p -> [(Text, ServerOperator)] -> [UserServer' s p] -> [ServerCfg p]
agentServerCfgs p opDomains = mapMaybe agentServer
where