core, ui: per-server roles for self-hosted servers (#7254)

* core, ui: plan per-server roles for self-hosted servers

* core: add per-server roles field to UserServer

* core: add nullable role columns to protocol_servers

* core: persist per-server roles

* core: validate server coverage using per-server roles

* test: cover per-server roles resolution and coverage

* multiplatform: per-server role toggles for self-hosted servers

* ios: per-server role toggles for self-hosted servers

* core: per-server role overrides with per-role defaults

* test: cover three-state per-server role resolution

* fix: derive Eq for ServerRolesOverride

* multiplatform: three-state role dropdowns on saved servers

* ios: three-state role pickers on saved servers

* test: per-server roles independent across two servers

* test: enable names role in name-resolution tests

* style: trim comments in per-server roles code

* chore: rename server_roles migration to 20260716 (last)

* core: per-server roles override operator roles, inherit when unset

* multiplatform: per-server role default inherits from operator

* ios: per-server role default inherits from operator

* refactor(servers): tidy per-server roles per review

- dedup no-operator default into ServerRoles.noOperatorDefault (Kotlin/Swift)
- iOS: move roles-section control flow to the call site via a named gate,
  and parse the server address once instead of up to three times
- Kotlin: collapse redundant derivedState; revert defaultOn->default rename
  for cross-platform parity
- drop unused Hashable conformance on Swift ServerRoles
- add agentServerCfgs test for names inheritance from an operator
- remove no-op enableNamesRole calls from dormant DirectoryTests
- fix ChatClient import ordering

* chore(migration): date server_roles migration 20260720

* only show roles when server is enabled, move section above QR code

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>

src/Simplex/Chat/Operators.hs

@@ -49,7 +49,7 @@ import Simplex.Chat.Operators.Conditions
 import Simplex.Chat.Protocol (RelayCapabilities (..), RelayProfile (..))
 import Simplex.Chat.Types (ShortLinkContact, User)
 import Simplex.Chat.Types.Shared (RelayStatus)
-import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles)
+import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..))
 import Simplex.Messaging.Agent.Protocol (sameShortLinkContact)
 import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
 import Simplex.Messaging.Agent.Store.Entity
@@ -176,6 +176,22 @@ operatorRoles p op = case p of
   SPSMP -> smpRoles op
   SPXFTP -> xftpRoles op
 
+data ServerRolesOverride = ServerRolesOverride
+  { storage :: Maybe Bool,
+    proxy :: Maybe Bool,
+    names :: Maybe Bool
+  }
+  deriving (Eq, Show)
+
+emptyServerRolesOverride :: ServerRolesOverride
+emptyServerRolesOverride = ServerRolesOverride {storage = Nothing, proxy = Nothing, names = Nothing}
+
+-- each role: override if set, else the operator's role (if any), else default (receive on, proxy on, names off)
+resolveServerRoles :: UserProtocol p => SProtocolType p -> Maybe ServerOperator -> ServerRolesOverride -> ServerRoles
+resolveServerRoles p op ServerRolesOverride {storage, proxy, names} =
+  ServerRoles {storage = fromMaybe s storage, proxy = fromMaybe pr proxy, names = fromMaybe n names}
+  where ServerRoles {storage = s, proxy = pr, names = n} = maybe (ServerRoles True True False) (operatorRoles p) op
+
 conditionsAccepted :: ServerOperator -> Bool
 conditionsAccepted ServerOperator {conditionsAcceptance} = case conditionsAcceptance of
   CAAccepted {} -> True
@@ -245,6 +261,7 @@ data UserServer' s (p :: ProtocolType) = UserServer
     preset :: Bool,
     tested :: Maybe Bool,
     enabled :: Bool,
+    roles :: ServerRolesOverride,
     deleted :: Bool
   }
   deriving (Show)
@@ -330,7 +347,7 @@ newUserServer = newUserServer_ False True
 
 newUserServer_ :: Bool -> Bool -> ProtoServerWithAuth p -> NewUserServer p
 newUserServer_ preset enabled server =
-  UserServer {serverId = DBNewEntity, server, preset, tested = Nothing, enabled, deleted = False}
+  UserServer {serverId = DBNewEntity, server, preset, tested = Nothing, enabled, roles = emptyServerRolesOverride, deleted = False}
 
 presetChatRelay :: Bool -> RelayProfile -> [Text] -> ShortLinkContact -> NewUserChatRelay
 presetChatRelay = newChatRelay_ True
@@ -439,13 +456,13 @@ agentServerCfgs :: UserProtocol p => SProtocolType p -> [(Text, ServerOperator)]
 agentServerCfgs p opDomains = mapMaybe agentServer
   where
     agentServer :: UserServer' s p -> Maybe (ServerCfg p)
-    agentServer srv@UserServer {server, enabled} =
+    agentServer srv@UserServer {server, enabled, roles = srvRoles} =
       case find (\(d, _) -> any (matchingHost d) (srvHost srv)) opDomains of
         Just (_, op@ServerOperator {operatorId = DBEntityId opId, enabled = opEnabled})
-          | opEnabled -> Just ServerCfg {server, enabled, operator = Just opId, roles = operatorRoles p op}
+          | opEnabled -> Just ServerCfg {server, enabled, operator = Just opId, roles = resolveServerRoles p (Just op) srvRoles}
           | otherwise -> Nothing
         Nothing ->
-          Just ServerCfg {server, enabled, operator = Nothing, roles = allRoles}
+          Just ServerCfg {server, enabled, operator = Nothing, roles = resolveServerRoles p Nothing srvRoles}
 
 matchingHost :: Text -> TransportHost -> Bool
 matchingHost d = \case
@@ -524,11 +541,10 @@ validateUserServers curr others = (currUserErrs <> concatMap otherUserErrs other
     noServersErrs :: (UserServersClass u, ProtocolTypeI p, UserProtocol p) => SProtocolType p -> Maybe User -> [u] -> [UserServersError]
     noServersErrs p user uss
       | noServers opEnabled = [USENoServers p' user]
-      | otherwise = [USEStorageMissing p' user | noServers (hasRole storage)] <> [USEProxyMissing p' user | noServers (hasRole proxy)]
+      | otherwise = [USEStorageMissing p' user | not (any (hasRole p (\ServerRoles {storage} -> storage)) uss)] <> [USEProxyMissing p' user | not (any (hasRole p (\ServerRoles {proxy} -> proxy)) uss)]
       where
         p' = AProtocolType p
         noServers cond = not $ any srvEnabled $ userServers p $ filter cond uss
-        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]
     serverErrs p uss = mapMaybe duplicateErr_ srvs
@@ -542,6 +558,10 @@ validateUserServers curr others = (currUserErrs <> concatMap otherUserErrs other
         allHosts = concatMap (\(AUS _ srv) -> L.toList $ srvHost srv) srvs
     userServers :: (UserServersClass u, UserProtocol p) => SProtocolType p -> [u] -> [AUserServer p]
     userServers p = map aUserServer' . concatMap (servers' p)
+    -- a group covers a role if its operator is enabled and some enabled server resolves it on
+    hasRole :: (UserServersClass u, UserProtocol p) => SProtocolType p -> (ServerRoles -> Bool) -> u -> Bool
+    hasRole p roleSel u =
+      opEnabled u && any (\(AUS _ UserServer {enabled, deleted, roles}) -> enabled && not deleted && roleSel (resolveServerRoles p (operator' u) roles)) (map aUserServer' (servers' p u))
     chatRelayErrs :: UserServersClass u => [u] -> [UserServersError]
     chatRelayErrs uss = concatMap duplicateErrs_ cRelays
       where
@@ -562,11 +582,7 @@ validateUserServers curr others = (currUserErrs <> concatMap otherUserErrs other
         noChatRelays cond = not $ any relayEnabled $ userChatRelays $ filter cond uss
         relayEnabled (AUCR _ UserChatRelay {deleted, enabled}) = enabled && not deleted
     noNamesServersWarns :: UserServersClass u => Maybe User -> [u] -> [UserServersWarning]
-    noNamesServersWarns user uss = [USWNoNamesServers user | noNamesServers]
-      where
-        noNamesServers = not $ any srvEnabled $ userServers SPSMP $ filter namesEnabled uss
-        srvEnabled (AUS _ UserServer {deleted, enabled}) = enabled && not deleted
-        namesEnabled = maybe True (\op@ServerOperator {enabled} -> enabled && names (operatorRoles SPSMP op)) . operator'
+    noNamesServersWarns user uss = [USWNoNamesServers user | not (any (hasRole SPSMP (\ServerRoles {names} -> names)) uss)]
     userChatRelays :: UserServersClass u => [u] -> [AUserChatRelay]
     userChatRelays = map aUserChatRelay' . concatMap chatRelays'
     opEnabled :: UserServersClass u => u -> Bool
@@ -591,6 +607,8 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "UCA") ''UsageConditionsAction)
 
 $(JQ.deriveJSON defaultJSON ''ServerOperatorConditions)
 
+$(JQ.deriveJSON defaultJSON ''ServerRolesOverride)
+
 instance ProtocolTypeI p => ToJSON (UserServer' s p) where
   toEncoding = $(JQ.mkToEncoding defaultJSON ''UserServer')
   toJSON = $(JQ.mkToJSON defaultJSON ''UserServer')