diff --git a/apps/ios/Shared/Model/AppAPITypes.swift b/apps/ios/Shared/Model/AppAPITypes.swift index 5707cf5d15..40b88ec338 100644 --- a/apps/ios/Shared/Model/AppAPITypes.swift +++ b/apps/ios/Shared/Model/AppAPITypes.swift @@ -1813,6 +1813,15 @@ struct ServerRoles: Equatable, Codable { var storage: Bool var proxy: Bool var names: Bool + + // roles applied when a server matches no operator, mirrors core resolveServerRoles (Operators.hs) + static let noOperatorDefault = ServerRoles(storage: true, proxy: true, names: false) +} + +struct ServerRolesOverride: Equatable, Codable, Hashable { + var storage: Bool? + var proxy: Bool? + var names: Bool? } struct UserOperatorServers: Identifiable, Equatable, Codable { @@ -1839,8 +1848,8 @@ struct UserOperatorServers: Identifiable, Equatable, Codable { serverDomains: [], conditionsAcceptance: .accepted(acceptedAt: nil, autoAccepted: false), enabled: false, - smpRoles: ServerRoles(storage: true, proxy: true, names: true), - xftpRoles: ServerRoles(storage: true, proxy: true, names: false) + smpRoles: ServerRoles.noOperatorDefault, + xftpRoles: ServerRoles.noOperatorDefault ) } set { `operator` = newValue } @@ -1962,11 +1971,12 @@ struct UserServer: Identifiable, Equatable, Codable, Hashable { var tested: Bool? var enabled: Bool var deleted: Bool + var roles: ServerRolesOverride = ServerRolesOverride() var createdAt = Date() static func == (l: UserServer, r: UserServer) -> Bool { l.serverId == r.serverId && l.server == r.server && l.preset == r.preset && l.tested == r.tested && - l.enabled == r.enabled && l.deleted == r.deleted + l.enabled == r.enabled && l.deleted == r.deleted && l.roles == r.roles } var id: String { "\(server) \(createdAt)" } @@ -2026,6 +2036,7 @@ struct UserServer: Identifiable, Equatable, Codable, Hashable { case tested case enabled case deleted + case roles } } diff --git a/apps/ios/Shared/Views/UserSettings/NetworkAndServers/ProtocolServerView.swift b/apps/ios/Shared/Views/UserSettings/NetworkAndServers/ProtocolServerView.swift index 5299b7d415..b953ade0a6 100644 --- a/apps/ios/Shared/Views/UserSettings/NetworkAndServers/ProtocolServerView.swift +++ b/apps/ios/Shared/Views/UserSettings/NetworkAndServers/ProtocolServerView.swift @@ -81,6 +81,9 @@ struct ProtocolServerView: View { .textSelection(.enabled) } useServerSection(true) + if let inherited = serverRolesInherited { + serverRolesSection(inherited: inherited) + } } } } @@ -110,6 +113,9 @@ struct ProtocolServerView: View { } } useServerSection(valid) + if let inherited = serverRolesInherited { + serverRolesSection(inherited: inherited) + } if valid { Section(header: Text("Add to another device").foregroundColor(theme.colors.secondary)) { MutableQRCode(uri: $serverToEdit.server, small: true) @@ -120,6 +126,33 @@ struct ProtocolServerView: View { } } + // inherited SMP roles for the per-server roles section, nil when the section should not be shown + private var serverRolesInherited: ServerRoles? { + guard let (serverProtocol, serverOperator) = serverProtocolAndOperator(serverToEdit, userServers), + serverProtocol == .smp && serverToEdit.enabled, !serverToEdit.preset || serverToEdit.roles != ServerRolesOverride() + else { return nil } + return serverOperator?.smpRoles ?? ServerRoles.noOperatorDefault + } + + private func serverRolesSection(inherited: ServerRoles) -> some View { + Section { + rolePicker("To receive", $serverToEdit.roles.storage, defaultOn: inherited.storage) + rolePicker("For private routing", $serverToEdit.roles.proxy, defaultOn: inherited.proxy) + rolePicker("To resolve names", $serverToEdit.roles.names, defaultOn: inherited.names) + } header: { + Text("Use for messages").foregroundColor(theme.colors.secondary) + } + } + + private func rolePicker(_ title: LocalizedStringKey, _ selection: Binding, defaultOn: Bool) -> some View { + Picker(title, selection: selection) { + Text(String.localizedStringWithFormat(NSLocalizedString("default (%@)", comment: "pref value"), NSLocalizedString(defaultOn ? "yes" : "no", comment: "pref value"))).tag(Bool?.none) + Text("yes").tag(Bool?.some(true)) + Text("no").tag(Bool?.some(false)) + } + .frame(height: 36) + } + private func useServerSection(_ valid: Bool) -> some View { Section(header: Text("Use server").foregroundColor(theme.colors.secondary)) { HStack { diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt index 4ebfec1faa..f9438fca32 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt @@ -4647,6 +4647,18 @@ data class ServerRoles( val storage: Boolean, val proxy: Boolean, val names: Boolean +) { + companion object { + // roles applied when a server matches no operator, mirrors core resolveServerRoles (Operators.hs) + val noOperatorDefault = ServerRoles(storage = true, proxy = true, names = false) + } +} + +@Serializable +data class ServerRolesOverride( + val storage: Boolean? = null, + val proxy: Boolean? = null, + val names: Boolean? = null ) @Serializable @@ -4668,8 +4680,8 @@ data class UserOperatorServers( serverDomains = emptyList(), conditionsAcceptance = ConditionsAcceptance.Accepted(null, autoAccepted = false), enabled = false, - smpRoles = ServerRoles(storage = true, proxy = true, names = true), - xftpRoles = ServerRoles(storage = true, proxy = true, names = false) + smpRoles = ServerRoles.noOperatorDefault, + xftpRoles = ServerRoles.noOperatorDefault ) companion object { @@ -4801,7 +4813,8 @@ data class UserServer( val preset: Boolean, val tested: Boolean? = null, val enabled: Boolean, - val deleted: Boolean + val deleted: Boolean, + val roles: ServerRolesOverride = ServerRolesOverride(), ) { @Transient private val createdAt: Date = Date() diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/networkAndServers/ProtocolServerView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/networkAndServers/ProtocolServerView.kt index b3326bd2e9..3c8cc9e0ce 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/networkAndServers/ProtocolServerView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/networkAndServers/ProtocolServerView.kt @@ -19,6 +19,7 @@ import androidx.compose.ui.text.font.FontFamily import androidx.compose.ui.unit.dp import androidx.compose.ui.unit.sp import chat.simplex.common.model.* +import chat.simplex.common.model.ChatController.appPrefs import chat.simplex.common.model.ServerAddress.Companion.parseServerAddress import chat.simplex.common.ui.theme.* import chat.simplex.common.views.helpers.* @@ -88,6 +89,7 @@ fun ProtocolServerView( ProtocolServerLayout( draftServer, serverProtocol, + userServers, testing.value, testServer = { testing.value = true @@ -120,6 +122,7 @@ fun ProtocolServerView( private fun ProtocolServerLayout( server: MutableState, serverProtocol: ServerProtocol, + userServers: MutableState>, testing: Boolean, testServer: () -> Unit, onDelete: () -> Unit, @@ -130,7 +133,7 @@ private fun ProtocolServerLayout( if (server.value.preset) { PresetServer(server, testing, testServer) } else { - CustomServer(server, testing, testServer, onDelete) + CustomServer(server, testing, testServer, onDelete, serverProtocol, userServers) } SectionBottomSpacer() } @@ -164,15 +167,11 @@ fun CustomServer( testing: Boolean, testServer: () -> Unit, onDelete: (() -> Unit)?, + serverProtocol: ServerProtocol? = null, + userServers: MutableState>? = null ) { val serverAddress = remember { mutableStateOf(server.value.server) } - val valid = remember { - derivedStateOf { - with(parseServerAddress(serverAddress.value)) { - this?.valid == true - } - } - } + val valid = remember { derivedStateOf { parseServerAddress(serverAddress.value)?.valid == true } } SectionView( stringResource(MR.strings.smp_servers_your_server_address), icon = painterResource(MR.images.ic_error), @@ -196,6 +195,12 @@ fun CustomServer( UseServerSection(server, valid.value, testing, testServer, onDelete) + val op = remember(server.value.server) { serverProtocolAndOperator(server.value, userServers?.value ?: listOf())?.second } + if (serverProtocol == ServerProtocol.SMP && server.value.enabled && (!server.value.preset || server.value.roles != ServerRolesOverride())) { + SectionDividerSpaced() + ServerRolesSection(server, op?.smpRoles ?: ServerRoles.noOperatorDefault) + } + if (valid.value) { SectionDividerSpaced() SectionView(stringResource(MR.strings.smp_servers_add_to_another_device)) { @@ -204,6 +209,38 @@ fun CustomServer( } } +@Composable +private fun ServerRolesSection(server: MutableState, inherited: ServerRoles) { + SectionView(stringResource(MR.strings.operator_use_for_messages)) { + RoleDropDown(stringResource(MR.strings.operator_use_for_messages_receiving), server.value.roles.storage, defaultOn = inherited.storage) { + server.value = server.value.copy(roles = server.value.roles.copy(storage = it)) + } + RoleDropDown(stringResource(MR.strings.operator_use_for_messages_private_routing), server.value.roles.proxy, defaultOn = inherited.proxy) { + server.value = server.value.copy(roles = server.value.roles.copy(proxy = it)) + } + RoleDropDown(stringResource(MR.strings.operator_use_for_names), server.value.roles.names, defaultOn = inherited.names) { + server.value = server.value.copy(roles = server.value.roles.copy(names = it)) + } + } +} + +@Composable +private fun RoleDropDown(title: String, value: Boolean?, defaultOn: Boolean, onSelected: (Boolean?) -> Unit) { + val values = remember(defaultOn, appPrefs.appLanguage.state.value) { + listOf( + null to String.format(generalGetString(MR.strings.chat_preferences_default), generalGetString(if (defaultOn) MR.strings.chat_preferences_yes else MR.strings.chat_preferences_no)), + true to generalGetString(MR.strings.chat_preferences_yes), + false to generalGetString(MR.strings.chat_preferences_no) + ) + } + ExposedDropDownSettingRow( + title, + values, + rememberUpdatedState(value), + onSelected = onSelected + ) +} + @Composable private fun UseServerSection( server: MutableState, diff --git a/plans/2026-07-14-self-hosted-server-roles-implementation.md b/plans/2026-07-14-self-hosted-server-roles-implementation.md new file mode 100644 index 0000000000..06c5064a99 --- /dev/null +++ b/plans/2026-07-14-self-hosted-server-roles-implementation.md @@ -0,0 +1,342 @@ +# Per-server roles for self-hosted servers — Implementation Plan + +> **For agentic workers:** REQUIRED: Use superpowers-extended-cc:subagent-driven-development (if subagents available) or superpowers-extended-cc:executing-plans to implement this plan. Steps use checkbox (`- [ ]`) syntax for tracking. + +**Goal:** Give each individual self-hosted SMP server its own receive / private-routing / name-resolution toggles, stored per server and plumbed to the agent. + +**Architecture:** Add `roles :: Maybe ServerRoles` to simplex-chat's `UserServer'`; store it in three nullable `protocol_servers` columns; resolve `Maybe → ServerRoles` in `agentServerCfgs` (default `storage+proxy` on, `names` off). No simplexmq change. Add the three toggles to custom SMP server screens on Kotlin and Swift. + +**Tech Stack:** Haskell (simplex-chat), SQLite + PostgreSQL migrations, Kotlin (multiplatform), Swift (iOS). Tests via `cabal test` (HSpec). + +**Design doc:** `plans/2026-07-14-self-hosted-server-roles-product.md` + +**Companion checkout:** simplex-chat builds against simplexmq pinned in `cabal.project:24`; the working `../simplexmq` already contains `ServerRoles{storage,proxy,names}`. To build/test locally against it, uncomment `packages: . ../simplexmq` (`cabal.project:2`). No simplexmq edits are made by this plan. + +--- + +## Chunk 1: Haskell backend (types, resolution, DB, store, validation, tests) + +### Task 1: Add per-server `roles` to `UserServer'` and resolve it in `agentServerCfgs` + +**Files:** +- Modify: `src/Simplex/Chat/Operators.hs:242-250` (type), `:331-333` (constructor), `:438-448` (resolution), add constant near `operatorRoles` (`:174`) + +- [ ] **Step 1: Add the field to `UserServer'`** (after `enabled`, before `deleted`) + +```haskell +data UserServer' s (p :: ProtocolType) = UserServer + { serverId :: DBEntityId' s, + server :: ProtoServerWithAuth p, + preset :: Bool, + tested :: Maybe Bool, + enabled :: Bool, + roles :: Maybe ServerRoles, + deleted :: Bool + } +``` + +- [ ] **Step 2: Add the default constant** (next to `operatorRoles`, `:174`) + +```haskell +-- Default roles for a self-hosted server without stored roles: receive + private +-- routing on, name resolution off. Also the default for newly added servers. +defaultUserServerRoles :: ServerRoles +defaultUserServerRoles = ServerRoles {storage = True, proxy = True, names = False} +``` + +- [ ] **Step 3: Set `roles = Nothing` in the sole constructor** `newUserServer_` (`:333`) + +```haskell +newUserServer_ preset enabled server = + UserServer {serverId = DBNewEntity, server, preset, tested = Nothing, enabled, roles = Nothing, deleted = False} +``` + +- [ ] **Step 4: Resolve per-server roles in `agentServerCfgs`** (`:442-448`). Bind the field via record pattern (no `OverloadedRecordDot`; bare `roles` selector is ambiguous with `ServerCfg.roles`). + +```haskell + 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} + | otherwise -> Nothing + Nothing -> + Just ServerCfg {server, enabled, operator = Nothing, roles = fromMaybe defaultUserServerRoles srvRoles} +``` + +- [ ] **Step 5: Drop the now-unused `allRoles` import.** `allRoles` (`Operators.hs:52`) had its only use at `:448`, which Step 4 replaces. Remove it from the import list to avoid an unused-import warning: + +```haskell +import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..)) +``` + +- [ ] **Step 6: Build.** `fromMaybe` is already imported in `Operators.hs`. `ServerRoles(..)` is imported (`:52`). + +Run: `cabal build lib:simplex-chat --ghc-options -O0` +Expected: compile errors only at other `UserServer{...}` construction sites — none exist beyond `newUserServer_` and `getProtocolServers` (fixed in Task 3). Record *patterns* elsewhere (`Operators.hs:410,416,532,537,538,568`, `Profiles.hs:981`) are unaffected. + +- [ ] **Step 7: Commit** `feat(servers): add per-server roles field to UserServer` + +### Task 2: Database migrations (SQLite + Postgres) + schema + +**Files:** +- Create: `src/Simplex/Chat/Store/SQLite/Migrations/M20260714_server_roles.hs` +- Create: `src/Simplex/Chat/Store/Postgres/Migrations/M20260714_server_roles.hs` +- Modify: `src/Simplex/Chat/Store/SQLite/Migrations.hs` (import + list), `src/Simplex/Chat/Store/Postgres/Migrations.hs` (import + list) +- Modify: `src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql`, `src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql` (regenerated, see Step 5) + +- [ ] **Step 1: SQLite migration** (template: `M20260707_file_digest.hs`, `M20260603_simplex_name.hs`) + +```haskell +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.SQLite.Migrations.M20260714_server_roles where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20260714_server_roles :: Query +m20260714_server_roles = + [sql| +ALTER TABLE protocol_servers ADD COLUMN role_storage INTEGER; +ALTER TABLE protocol_servers ADD COLUMN role_proxy INTEGER; +ALTER TABLE protocol_servers ADD COLUMN role_names INTEGER; +|] + +down_m20260714_server_roles :: Query +down_m20260714_server_roles = + [sql| +ALTER TABLE protocol_servers DROP COLUMN role_storage; +ALTER TABLE protocol_servers DROP COLUMN role_proxy; +ALTER TABLE protocol_servers DROP COLUMN role_names; +|] +``` + +- [ ] **Step 2: Postgres migration** (template: Postgres `M20260707_file_digest.hs`; `[r|...|]` and `Text`) + +```haskell +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.Postgres.Migrations.M20260714_server_roles where + +import Data.Text (Text) +import Text.RawString.QQ (r) + +m20260714_server_roles :: Text +m20260714_server_roles = + [r| +ALTER TABLE protocol_servers ADD COLUMN role_storage SMALLINT; +ALTER TABLE protocol_servers ADD COLUMN role_proxy SMALLINT; +ALTER TABLE protocol_servers ADD COLUMN role_names SMALLINT; +|] + +down_m20260714_server_roles :: Text +down_m20260714_server_roles = + [r| +ALTER TABLE protocol_servers DROP COLUMN role_storage; +ALTER TABLE protocol_servers DROP COLUMN role_proxy; +ALTER TABLE protocol_servers DROP COLUMN role_names; +|] +``` + +- [ ] **Step 3: Register SQLite migration** (`SQLite/Migrations.hs`): add `import ...M20260714_server_roles` after the `M20260707_file_digest` import (`:166`), and append to the list after the `20260707_file_digest` entry (`:330`) — add a comma to that line: + +```haskell + ("20260707_file_digest", m20260707_file_digest, Just down_m20260707_file_digest), + ("20260714_server_roles", m20260714_server_roles, Just down_m20260714_server_roles) +``` + +- [ ] **Step 4: Register Postgres migration** (`Postgres/Migrations.hs`): mirror Step 3 at the import (`:43`) and list (`:84`). + +- [ ] **Step 5: Regenerate reference schema.** The repo keeps `chat_schema.sql` in sync with migrations (see the "ci: update query plans" commits). Regenerate both SQLite and Postgres `chat_schema.sql` using the repo's schema-dump script rather than hand-editing. If no script is found, hand-add the three columns to the `protocol_servers` block in both `chat_schema.sql` files (SQLite `INTEGER`, Postgres `smallint`). + +Run: `cabal build lib:simplex-chat --ghc-options -O0` +Expected: PASS. + +- [ ] **Step 6: Commit** `feat(servers): add nullable role columns to protocol_servers` + +### Task 3: Store read/write of `roles` (`Profiles.hs`) + +**Files:** +- Modify: `src/Simplex/Chat/Store/Profiles.hs:639-654` (select/read), `:656-667` (insert), `:669-679` (update) + +- [ ] **Step 1: Read roles in `getProtocolServers`.** Extend the SELECT and `toUserServer`. Store roles as three nullable `BoolInt` columns; reconstruct `Maybe ServerRoles` (all present → `Just`, else `Nothing`). + +**MUST split with `:.`.** The existing select is 8 columns → an 8-tuple. Adding 3 gives 11, but the SQLite/Postgres `FromRow` instances cap flat tuples at **10** — an 11-element flat tuple has no instance and will not compile. Parse the 3 role columns as a trailing group via `:.`. + +```haskell + [sql| + SELECT smp_server_id, host, port, key_hash, basic_auth, preset, tested, enabled, + role_storage, role_proxy, role_names + FROM protocol_servers + WHERE user_id = ? AND protocol = ? + |] +``` + +```haskell + toUserServer :: ((DBEntityId, NonEmpty TransportHost, String, C.KeyHash, Maybe Text, BoolInt, Maybe BoolInt, BoolInt) :. (Maybe BoolInt, Maybe BoolInt, Maybe BoolInt)) -> UserServer p + toUserServer ((serverId, host, port, keyHash, auth_, BI preset, tested, BI enabled) :. (rStorage, rProxy, rNames)) = + let server = ProtoServerWithAuth (ProtocolServer p host port keyHash) (BasicAuth . encodeUtf8 <$> auth_) + roles = ServerRoles <$> (unBI <$> rStorage) <*> (unBI <$> rProxy) <*> (unBI <$> rNames) + in UserServer {serverId, server, preset, tested = unBI <$> tested, enabled, roles, deleted = False} +``` + +`ServerRoles <$> mA <*> mB <*> mC :: Maybe ServerRoles` (Applicative on `Maybe`) yields `Just` only when all three are present, else `Nothing` — matching the all-or-none storage. Constructor arg order (`storage, proxy, names`) matches the column order. Ensure `:.` (from the DB simple package) and `ServerRoles(..)` are imported in `Profiles.hs`. + +- [ ] **Step 2: Write roles in `insertProtocolServer`.** Add the columns and values (extract `roles` via record pattern): + +```haskell +insertProtocolServer db p User {userId} ts srv@UserServer {server, preset, tested, enabled, roles} = do + DB.execute + db + [sql| + INSERT INTO protocol_servers + (protocol, host, port, key_hash, basic_auth, preset, tested, enabled, + role_storage, role_proxy, role_names, user_id, created_at, updated_at) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?) + |] + (serverColumns p server :. (BI preset, BI <$> tested, BI enabled) :. roleColumns roles :. (userId, ts, ts)) +``` + +- [ ] **Step 3: Write roles in `updateProtocolServer`** similarly: + +```haskell +updateProtocolServer db p ts UserServer {serverId, server, preset, tested, enabled, roles} = + DB.execute + db + [sql| + UPDATE protocol_servers + SET protocol = ?, host = ?, port = ?, key_hash = ?, basic_auth = ?, + preset = ?, tested = ?, enabled = ?, + role_storage = ?, role_proxy = ?, role_names = ?, updated_at = ? + WHERE smp_server_id = ? + |] + (serverColumns p server :. (BI preset, BI <$> tested, BI enabled) :. roleColumns roles :. (ts, serverId)) +``` + +- [ ] **Step 4: Add the `roleColumns` helper** (private, in `Profiles.hs`). Map each selector over the `Maybe` — no two-branch `case`, so the all-or-none property is structural (a `Nothing` maps to three `Nothing`s automatically): + +```haskell +roleColumns :: Maybe ServerRoles -> (Maybe BoolInt, Maybe BoolInt, Maybe BoolInt) +roleColumns mr = (BI . storage <$> mr, BI . proxy <$> mr, BI . names <$> mr) +``` + +(`storage`/`proxy`/`names` are unambiguous selectors — unique to `ServerRoles`. If a future duplicate makes them ambiguous under `DuplicateRecordFields`, fall back to a punned `\case`.) + +- [ ] **Step 5: Build.** `cabal build lib:simplex-chat --ghc-options -O0` → PASS. +- [ ] **Step 6: Commit** `feat(servers): persist per-server roles` + +### Task 4: Update validation for the custom (self-hosted) bucket + +**Files:** +- Modify: `src/Simplex/Chat/Operators.hs:524-532` (`noServersErrs`, `hasRole`), `:564-569` (`noNamesServersWarns`, `namesEnabled`) + +This task **fuses two parallel role-coverage helpers into one.** `hasRole` (`:531`, storage/proxy) and `namesEnabled` (`:569`, names) are the same group-level check specialised to different role selectors, both returning `True` for the custom bucket. They cannot express per-server roles, so both are replaced by a single role-parameterised `hasRoleCoverage`. + +**Preserve** (do not touch): `noServers` + `srvEnabled` (still used for the `USENoServers` empty-check at `:526`) and `opEnabled` (also used by `noChatRelaysWarns`, `:560`). **Remove:** `hasRole` and `namesEnabled`. + +- [ ] **Step 1: Make coverage checks per-server-role-aware for the no-operator bucket.** Today `hasRole`/`namesEnabled` return `True` for the custom bucket (`operator' = Nothing`) and are group-level `u -> Bool` filters combined with `noServers cond = not $ any srvEnabled $ userServers p $ filter cond uss`. Group-level filtering **cannot** express per-server roles for the custom bucket — the evaluation must move to the per-server level. + +**Effective-role helper** — takes the protocol singleton (`operatorRoles` needs it; `noServersErrs` runs for BOTH SMP and XFTP at `:522-523`, so hardcoding `SPSMP` would read `smpRoles` for XFTP operator servers — a bug): + +```haskell +-- effective role for coverage: operator servers use operator roles (per protocol), +-- self-hosted servers use per-server roles (default when unset). +serverHasRole :: UserProtocol p => SProtocolType p -> (ServerRoles -> Bool) -> Maybe ServerOperator -> Maybe ServerRoles -> Bool +serverHasRole p roleSel op srvRoles = case op of + Just o@ServerOperator {enabled} -> enabled && roleSel (operatorRoles p o) + Nothing -> roleSel (fromMaybe defaultUserServerRoles srvRoles) +``` + +**Restructure the checks to per-server evaluation.** For a role selector, "coverage exists" = any enabled, non-deleted server in any bucket whose effective role is on. Per bucket `u` the operator is `operator' u` and each server's roles come from `AUS _ UserServer{enabled, deleted, roles}` (the `roles` field is reachable — same pattern already used at `:532,:568`): + +```haskell + hasRoleCoverage :: (UserServersClass u, ProtocolTypeI p, UserProtocol p) => SProtocolType p -> (ServerRoles -> Bool) -> [u] -> Bool + hasRoleCoverage p roleSel = + any (\u -> any (srvOk (operator' u)) (map aUserServer' (servers' p u))) + where + srvOk op (AUS _ UserServer {enabled, deleted, roles}) = + enabled && not deleted && serverHasRole p roleSel op roles +``` + +Then rewrite `noServersErrs` (`:527`) storage/proxy branches as `[USEStorageMissing p' user | not (hasRoleCoverage p storage uss)] <> [USEProxyMissing p' user | not (hasRoleCoverage p proxy uss)]` (keep the `noServers opEnabled` empty-check at `:526` as-is), and `noNamesServersWarns` (`:565`) as `[USWNoNamesServers user | not (hasRoleCoverage SPSMP names uss)]`. Keep the exact constructors (`USEStorageMissing`, `USEProxyMissing`, `USWNoNamesServers`). XFTP `names` is never checked (names coverage is SMP-only). + +**Deliberate duplication (do not try to unify with `agentServerCfgs`).** Both this helper and `agentServerCfgs` (Task 1) resolve "operator-vs-self-hosted → effective roles", but their semantics for a *disabled operator* differ: `agentServerCfgs` drops the server entirely (`opEnabled … | otherwise -> Nothing`), whereas coverage treats it as contributing no roles while `USENoServers` handles existence. They also run over different shapes (`[ServerCfg]` per user vs. `[UserOperatorServers]` across users). Unifying them would grow the blast radius for no clarity gain; the shared logic is a 2-line `case` — leave it in both. (Flag for future: if a third consumer appears, extract `effectiveServerRoles :: SProtocolType p -> Maybe ServerOperator -> Maybe ServerRoles -> Maybe ServerRoles`.) + +- [ ] **Step 2: Build + reason through each call site.** Ensure `noServers`/`noNamesServers` now consult per-server roles for the custom bucket. `cabal build lib:simplex-chat --ghc-options -O0` → PASS. +- [ ] **Step 3: Commit** `fix(servers): validate coverage using per-server roles` + +### Task 5: Haskell tests + +**Files:** +- Modify/Create: server-config test module (locate the existing `agentServerCfgs` / operators test; e.g. under `tests/` — search `agentServerCfgs`, `validateUserServers`, `Operators`). If none, add `tests/ChatTests/ServerRolesTest.hs` and register it in the test runner. + +- [ ] **Step 1: Write failing tests.** + - `agentServerCfgs` for a self-hosted SMP server with `roles = Just (ServerRoles True False True)` → `ServerCfg.roles == ServerRoles True False True`, `operator == Nothing`. + - self-hosted with `roles = Nothing` → `ServerCfg.roles == defaultUserServerRoles` (`names == False`). + - operator-matched server ignores per-server `roles` → uses `operatorRoles`. + - store round-trip: insert a self-hosted server with `Just` roles, read back equal; insert with `Nothing`, read back `Nothing`. + - `validateUserServers`: custom-bucket-only user with all servers `names = False` → `USWNoNamesServers` present; enabling `names` on one → absent. +- [ ] **Step 2: Run, expect FAIL.** `cabal test --test-option=--match="/ServerRoles/"` +- [ ] **Step 3: (Implementation already done in Tasks 1–4.)** Run, expect PASS. +- [ ] **Step 4: Commit** `test(servers): cover per-server roles resolution and storage` + +--- + +## Chunk 2: UI (Kotlin + Swift) + +### Task 6: Kotlin (Desktop/Android) model + toggles + +**Files:** +- Modify: `apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt:4787` (`UserServer`), `:4808,4818-4845` (sample/empty), and `.../networkAndServers/ScanProtocolServer.kt:22` +- Modify: `.../networkAndServers/ProtocolServerView.kt` (`UseServerSection` / `CustomServer`, ~`:161-234`) and `.../networkAndServers/NewServerView.kt` +- Reference: `.../networkAndServers/OperatorView.kt:260-320` (toggle pattern), `ServerRoles` (`SimpleXAPI.kt:4636`) + +- [ ] **Step 1: Add `roles` to `UserServer`** with default to avoid breaking constructors: + +```kotlin +val roles: ServerRoles? = null, +``` +Place it before `deleted`; update the primary constructor and the named-arg call sites (`empty` `:4808`, samples `:4818-4845`, `ScanProtocolServer.kt:22`). Since it has a default, unchanged call sites still compile. + +- [ ] **Step 2: Add the toggles to custom SMP servers.** In `ProtocolServerView.kt`, inside `CustomServer` / `UseServerSection`, when `server.protocol == smp && !server.preset`, add a `SectionView(MR.strings.operator_use_for_messages)` with three `PreferenceToggle` rows bound to the server's roles (receive → `storage`, private routing → `proxy`, names → `names`), mirroring `OperatorView.kt:261-320`. Editing writes back a new `ServerRoles` onto the edited `UserServer` state. Default the displayed roles to `ServerRoles(storage = true, proxy = true, names = false)` when `roles == null`. + - Strings: `operator_use_for_messages`, `operator_use_for_messages_receiving`, `operator_use_for_messages_private_routing`, `operator_use_for_names` (already exist, `strings.xml:2195-2198`). + - Do NOT show for XFTP or preset/operator servers. + +- [ ] **Step 3: New-server default.** In `NewServerView.kt`, construct the new SMP `UserServer` with `roles = ServerRoles(storage = true, proxy = true, names = false)` so the toggles show the default and persist on save. + +- [ ] **Step 4: Build.** Compile the multiplatform common module (repo's gradle/build command). +- [ ] **Step 5: Commit** `feat(servers): per-server role toggles on Android/desktop` + +### Task 7: Swift (iOS) model + toggles + +**Files:** +- Modify: `apps/ios/Shared/Model/AppAPITypes.swift:1953` (`UserServer` struct + `CodingKeys` `:2017`) +- Modify: `apps/ios/Shared/Views/UserSettings/NetworkAndServers/ProtocolServerView.swift` (`customServer()` / `useServerSection` `:88,123`) and `NewServerView.swift` +- Reference: `.../NetworkAndServers/OperatorView.swift:106-114` (toggle pattern), `ServerRoles` (`AppAPITypes.swift:1807`) + +- [ ] **Step 1: Add `roles` to `UserServer`.** + +```swift +var roles: ServerRoles? +``` +Add `case roles` to `CodingKeys` (`:2017`). Update initializers / sample data accordingly. + +- [ ] **Step 2: Add the toggles to custom SMP servers.** In `ProtocolServerView.swift`, inside `customServer()` / `useServerSection`, when the server is SMP and `!preset`, add a `Section("Use for messages")` with three `Toggle`s bound to the server's roles (`"To receive"` → `storage`, `"For private routing"` → `proxy`, `"To resolve names"` → `names`), mirroring `OperatorView.swift:106-114`. Bind to the edited server's `roles`, defaulting to `ServerRoles(storage: true, proxy: true, names: false)` when `nil`. + - iOS string keys are the literal English text (already used by `OperatorView.swift`); `"To resolve names"` may still need adding to `Localizable.strings` translations (English == key). + - Do NOT show for XFTP or preset/operator servers. + +- [ ] **Step 3: New-server default.** In `NewServerView.swift`, default the new SMP server's `roles` to `ServerRoles(storage: true, proxy: true, names: false)`. + +- [ ] **Step 4: Build** the iOS target (or type-check the changed files). +- [ ] **Step 5: Commit** `feat(servers): per-server role toggles on iOS` + +--- + +## Verification (whole feature) + +- [ ] `cabal test --test-option=--match="/ServerRoles/"` passes. +- [ ] Full backend build: `cabal build --ghc-options -O0`. +- [ ] Migration up/down: apply and roll back `20260714_server_roles` on a copy DB (SQLite + Postgres); confirm existing rows read as `roles = Nothing` → resolved to `defaultUserServerRoles`. +- [ ] Manual UI: add two self-hosted SMP servers, set different role toggles on each, save, reopen — toggles are independent and persisted; name resolution defaults off; toggles absent on XFTP and operator servers. +- [ ] Round-trip via API: `APIGetUserServers` returns `roles` for edited servers and omits it (Nothing) for untouched ones. diff --git a/plans/2026-07-14-self-hosted-server-roles-product.md b/plans/2026-07-14-self-hosted-server-roles-product.md new file mode 100644 index 0000000000..d91fdc2ff2 --- /dev/null +++ b/plans/2026-07-14-self-hosted-server-roles-product.md @@ -0,0 +1,138 @@ +# Per-server roles for self-hosted servers — Product / Design + +**Date:** 2026-07-14 +**Status:** Design (approved for planning) +**Scope:** simplex-chat backend + DB + Desktop/Android (Kotlin) + iOS (Swift). **No simplexmq changes.** + +## Problem + +Self-hosted SMP servers cannot be configured individually for what they are used +for. The three capabilities — **receiving** messages (`storage` role), **private +routing** (`proxy` role), and **name resolution** (`names` role) — are controlled +only per *operator* (SimpleX / Flux), via the operator toggles in `OperatorView`. +Servers the user adds themselves fall into the "custom" / no-operator bucket and +are hard-coded to `allRoles` (all three on) in `agentServerCfgs` +(`src/Simplex/Chat/Operators.hs:448`). There is no UI, storage, or type to give a +single self-hosted server a subset of roles. + +This is a problem because a self-hosted server is usually not a name resolver +(name resolution needs an Ethereum/SNRC endpoint via `[NAMES] enable: on` on the +smp-server). Today such a server is still offered to the agent as names-capable, +so a name lookup can be routed to it and fail. Users also may want a self-hosted +server used only for receiving, or only for private routing. + +## Goal + +Give **each individual added self-hosted SMP server** its own independent toggles: +**To receive** / **For private routing** / **To resolve names**, stored per server +and plumbed to the agent as that server's `ServerRoles`. + +## Current state (verified) + +- **Agent (simplexmq) — already complete.** `ServerCfg { server, operator :: Maybe + OperatorId, enabled, roles :: ServerRoles }` and `ServerRoles { storage, proxy, + names }` exist (`Simplex/Messaging/Agent/Env/SQLite.hs:98,106`). The agent + partitions servers into `storageSrvs / proxySrvs / nameSrvs` in `mkUserServers` + and consumes them (`getNextServer`, `getSMPProxyClient`, `getNextNameServer` / + `resolveName` / RSLV). The agent always receives **concrete** `ServerRoles` and + never applies defaults. +- **simplex-chat backend.** `UserServer'` (`Operators.hs:242`) has **no roles + field**. Roles are resolved only in `agentServerCfgs` (`Operators.hs:438-448`): + operator servers → `operatorRoles p op` (read from `server_operators` columns); + self-hosted servers → hard-coded `allRoles`. +- **DB.** `protocol_servers` (`chat_schema.sql:548`) stores all user servers with + only `enabled / preset / tested` — **no operator link and no role columns**. + Roles live only per-operator in `server_operators` + (`smp_role_storage/proxy/names`, `xftp_role_storage/proxy`). +- **UI.** Operator screens (`OperatorView.kt:260-320`, `OperatorView.swift:106-114`) + have the three toggles. The individual server screens + (`ProtocolServerView`, `NewServerView` on both platforms) show only + address / test / enabled / delete. Client `UserServer` + (`SimpleXAPI.kt:4787`, `AppAPITypes.swift:1953`) has no roles field. + +## Decisions + +1. **Where the logic lives — no simplexmq change.** The accurate, consistent + approach follows the existing layering: the agent always gets a concrete + `ServerRoles`; the only place roles are resolved/defaulted is simplex-chat's + `agentServerCfgs`. We keep the `Maybe ServerRoles → ServerRoles` resolution + there, alongside the existing `allRoles` / `operatorRoles` handling. No core + version bump, no wire/protocol change. +2. **SMP self-hosted only.** SMP has all three roles; XFTP has no `names` role. + The toggles are shown only for custom (non-preset) SMP servers. XFTP + self-hosted servers are functionally unchanged. +3. **Legacy default `NULL → names OFF`.** For rows without stored roles (existing + servers after upgrade, or servers not yet edited) the resolved value is + `defaultUserServerRoles = ServerRoles { storage = True, proxy = True, names = + False }`. This is also the default for newly added servers, so migrated and new + servers behave identically: receive + private routing on, name resolution off. + +## Design + +### Types (`Operators.hs`) + +- Add `roles :: Maybe ServerRoles` to `UserServer'` (per-server; `Nothing` = use + default). `DuplicateRecordFields` is already enabled (both `ServerCfg` and + `UserServer'` will have a `roles` field). +- Add `defaultUserServerRoles :: ServerRoles = ServerRoles True True False`. +- `agentServerCfgs`, self-hosted branch (`:448`): + `roles = fromMaybe defaultUserServerRoles (roles srv)`. Operator branch + unchanged — the per-server field is ignored for operator-matched servers, so + operator roles still win. + +Per-server, not global: `roles` is one value per `UserServer`; each server +resolves to its own `ServerCfg`. + +### Storage (`protocol_servers`) + +Three **nullable** columns (mirrors `server_operators`): `role_storage`, +`role_proxy`, `role_names` (INTEGER, no default → existing rows NULL). Read into +`Maybe ServerRoles` (all three present → `Just`, else `Nothing`); write all three +from `roles`. + +### chat↔UI API + +`UserServer'` JSON is derived with `defaultJSON` (`omitNothingFields = True`), so +the new `Maybe` `roles` field is omitted when `Nothing` — exactly like the +existing `tested :: Maybe Bool`. Older clients/servers remain compatible. + +### Validation (`Operators.hs:519-577`) + +`noNamesServersWarns` (`:564-569`) and `noServersErrs`'s `hasRole` (`:531`) +currently derive coverage from the *operator* and treat the no-operator (custom) +bucket as `True` for every role. With per-server roles and names-off default this +would be wrong (a self-hosted-only user would never see "no name servers"). These +must evaluate the custom bucket from each server's resolved per-server `roles`. + +### UI (Kotlin + Swift) + +- Add `roles: ServerRoles?` to the client `UserServer`. +- On custom (non-preset) **SMP** server screens only — `ProtocolServerView` and + `NewServerView`, both platforms — add a "Use for messages" section with the + three toggles, mirroring `OperatorView`. Reuse existing string keys: + `operator_use_for_messages`, `operator_use_for_messages_receiving`, + `operator_use_for_messages_private_routing`, `operator_use_for_names`. +- New server default: `storage = on, proxy = on, names = off`. + +## Behavior / backward compatibility + +- Existing self-hosted servers keep receive + private routing; name resolution is + off after upgrade (intentional — avoids routing lookups to non-resolver + servers). A user who wants a self-hosted resolver enables the toggle. +- No protocol / wire change; no simplexmq change; operator behavior unchanged. + +## Out of scope + +- Per-server roles for operator (SimpleX/Flux) servers — they keep operator-level + roles. +- XFTP per-server roles. +- Any change to the name-resolution protocol or the agent. + +## Testing strategy + +- Haskell: unit tests for `agentServerCfgs` (self-hosted `Just`/`Nothing` → + correct `ServerCfg.roles`; operator servers ignore per-server roles), store + round-trip of `roles` through `protocol_servers`, and `validateUserServers` + names/storage/proxy coverage for the custom bucket. +- UI: manual verification that toggles render only for custom SMP servers, persist + per server, default names-off, and survive save/reload. diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 9cd2e1dd7f..f410089bff 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -151,6 +151,7 @@ library Simplex.Chat.Store.Postgres.Migrations.M20260714_member_security_code Simplex.Chat.Store.Postgres.Migrations.M20260715_profile_description Simplex.Chat.Store.Postgres.Migrations.M20260716_signed_history + Simplex.Chat.Store.Postgres.Migrations.M20260720_server_roles else exposed-modules: Simplex.Chat.Archive @@ -319,6 +320,7 @@ library Simplex.Chat.Store.SQLite.Migrations.M20260714_member_security_code Simplex.Chat.Store.SQLite.Migrations.M20260715_profile_description Simplex.Chat.Store.SQLite.Migrations.M20260716_signed_history + Simplex.Chat.Store.SQLite.Migrations.M20260720_server_roles other-modules: Paths_simplex_chat hs-source-dirs: diff --git a/src/Simplex/Chat/Operators.hs b/src/Simplex/Chat/Operators.hs index ad03529613..a216bbb1fc 100644 --- a/src/Simplex/Chat/Operators.hs +++ b/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') diff --git a/src/Simplex/Chat/Store/Postgres/Migrations.hs b/src/Simplex/Chat/Store/Postgres/Migrations.hs index 58e2d9ea45..3131cbd245 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations.hs @@ -44,6 +44,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260707_file_digest import Simplex.Chat.Store.Postgres.Migrations.M20260714_member_security_code import Simplex.Chat.Store.Postgres.Migrations.M20260715_profile_description import Simplex.Chat.Store.Postgres.Migrations.M20260716_signed_history +import Simplex.Chat.Store.Postgres.Migrations.M20260720_server_roles import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Text, Maybe Text)] @@ -87,7 +88,8 @@ schemaMigrations = ("20260707_file_digest", m20260707_file_digest, Just down_m20260707_file_digest), ("20260714_member_security_code", m20260714_member_security_code, Just down_m20260714_member_security_code), ("20260715_profile_description", m20260715_profile_description, Just down_m20260715_profile_description), - ("20260716_signed_history", m20260716_signed_history, Just down_m20260716_signed_history) + ("20260716_signed_history", m20260716_signed_history, Just down_m20260716_signed_history), + ("20260720_server_roles", m20260720_server_roles, Just down_m20260720_server_roles) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20260720_server_roles.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20260720_server_roles.hs new file mode 100644 index 0000000000..dcfb532e03 --- /dev/null +++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20260720_server_roles.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.Postgres.Migrations.M20260720_server_roles where + +import Data.Text (Text) +import Text.RawString.QQ (r) + +m20260720_server_roles :: Text +m20260720_server_roles = + [r| +ALTER TABLE protocol_servers ADD COLUMN role_storage SMALLINT; +ALTER TABLE protocol_servers ADD COLUMN role_proxy SMALLINT; +ALTER TABLE protocol_servers ADD COLUMN role_names SMALLINT; +|] + +down_m20260720_server_roles :: Text +down_m20260720_server_roles = + [r| +ALTER TABLE protocol_servers DROP COLUMN role_storage; +ALTER TABLE protocol_servers DROP COLUMN role_proxy; +ALTER TABLE protocol_servers DROP COLUMN role_names; +|] diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql index 9489d1bcd7..e901c8858e 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql @@ -1187,7 +1187,10 @@ CREATE TABLE test_chat_schema.protocol_servers ( user_id bigint NOT NULL, created_at timestamp with time zone DEFAULT now() NOT NULL, updated_at timestamp with time zone DEFAULT now() NOT NULL, - protocol text DEFAULT 'smp'::text NOT NULL + protocol text DEFAULT 'smp'::text NOT NULL, + role_storage smallint, + role_proxy smallint, + role_names smallint ); diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 19120bca27..ce6a8c4c9f 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -642,41 +642,45 @@ getProtocolServers db p User {userId} = <$> DB.query db [sql| - SELECT smp_server_id, host, port, key_hash, basic_auth, preset, tested, enabled + SELECT smp_server_id, host, port, key_hash, basic_auth, preset, tested, enabled, + role_storage, role_proxy, role_names FROM protocol_servers WHERE user_id = ? AND protocol = ? |] (userId, decodeLatin1 $ strEncode p) where - toUserServer :: (DBEntityId, NonEmpty TransportHost, String, C.KeyHash, Maybe Text, BoolInt, Maybe BoolInt, BoolInt) -> UserServer p - toUserServer (serverId, host, port, keyHash, auth_, BI preset, tested, BI enabled) = + toUserServer :: ((DBEntityId, NonEmpty TransportHost, String, C.KeyHash, Maybe Text, BoolInt, Maybe BoolInt, BoolInt) :. (Maybe BoolInt, Maybe BoolInt, Maybe BoolInt)) -> UserServer p + toUserServer ((serverId, host, port, keyHash, auth_, BI preset, tested, BI enabled) :. (rStorage, rProxy, rNames)) = let server = ProtoServerWithAuth (ProtocolServer p host port keyHash) (BasicAuth . encodeUtf8 <$> auth_) - in UserServer {serverId, server, preset, tested = unBI <$> tested, enabled, deleted = False} + roles = ServerRolesOverride (unBI <$> rStorage) (unBI <$> rProxy) (unBI <$> rNames) + in UserServer {serverId, server, preset, tested = unBI <$> tested, enabled, roles, deleted = False} insertProtocolServer :: forall p. ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> UTCTime -> NewUserServer p -> IO (UserServer p) -insertProtocolServer db p User {userId} ts srv@UserServer {server, preset, tested, enabled} = do +insertProtocolServer db p User {userId} ts srv@UserServer {server, preset, tested, enabled, roles} = do DB.execute db [sql| INSERT INTO protocol_servers - (protocol, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at) - VALUES (?,?,?,?,?,?,?,?,?,?,?) + (protocol, host, port, key_hash, basic_auth, preset, tested, enabled, + role_storage, role_proxy, role_names, user_id, created_at, updated_at) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] - (serverColumns p server :. (BI preset, BI <$> tested, BI enabled, userId, ts, ts)) + (serverColumns p server :. (BI preset, BI <$> tested, BI enabled) :. roleColumns roles :. (userId, ts, ts)) sId <- insertedRowId db pure (srv :: NewUserServer p) {serverId = DBEntityId sId} updateProtocolServer :: ProtocolTypeI p => DB.Connection -> SProtocolType p -> UTCTime -> UserServer p -> IO () -updateProtocolServer db p ts UserServer {serverId, server, preset, tested, enabled} = +updateProtocolServer db p ts UserServer {serverId, server, preset, tested, enabled, roles} = DB.execute db [sql| UPDATE protocol_servers SET protocol = ?, host = ?, port = ?, key_hash = ?, basic_auth = ?, - preset = ?, tested = ?, enabled = ?, updated_at = ? + preset = ?, tested = ?, enabled = ?, + role_storage = ?, role_proxy = ?, role_names = ?, updated_at = ? WHERE smp_server_id = ? |] - (serverColumns p server :. (BI preset, BI <$> tested, BI enabled, ts, serverId)) + (serverColumns p server :. (BI preset, BI <$> tested, BI enabled) :. roleColumns roles :. (ts, serverId)) serverColumns :: ProtocolTypeI p => SProtocolType p -> ProtoServerWithAuth p -> (Text, NonEmpty TransportHost, String, C.KeyHash, Maybe Text) serverColumns p (ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_) = @@ -684,6 +688,9 @@ serverColumns p (ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_) auth = safeDecodeUtf8 . unBasicAuth <$> auth_ in (protocol, host, port, keyHash, auth) +roleColumns :: ServerRolesOverride -> (Maybe BoolInt, Maybe BoolInt, Maybe BoolInt) +roleColumns ServerRolesOverride {storage, proxy, names} = (BI <$> storage, BI <$> proxy, BI <$> names) + getChatRelays :: DB.Connection -> User -> IO [UserChatRelay] getChatRelays db User {userId} = map toChatRelay @@ -772,7 +779,10 @@ updateServerOperator db currentTs ServerOperator {operatorId, enabled, smpRoles, SET enabled = ?, smp_role_storage = ?, smp_role_proxy = ?, smp_role_names = ?, xftp_role_storage = ?, xftp_role_proxy = ?, updated_at = ? WHERE server_operator_id = ? |] - (BI enabled, BI (storage smpRoles), BI (proxy smpRoles), BI (names smpRoles), BI (storage xftpRoles), BI (proxy xftpRoles), currentTs, operatorId) + (BI enabled, BI smpStorage, BI smpProxy, BI smpNames, BI xftpStorage, BI xftpProxy, currentTs, operatorId) + where + ServerRoles {storage = smpStorage, proxy = smpProxy, names = smpNames} = smpRoles + ServerRoles {storage = xftpStorage, proxy = xftpProxy} = xftpRoles getUpdateServerOperators :: DB.Connection -> NonEmpty PresetOperator -> Bool -> IO [(Maybe PresetOperator, Maybe ServerOperator)] getUpdateServerOperators db presetOps newUser = do @@ -810,7 +820,10 @@ getUpdateServerOperators db presetOps newUser = do SET trade_name = ?, legal_name = ?, server_domains = ?, enabled = ?, smp_role_storage = ?, smp_role_proxy = ?, smp_role_names = ?, xftp_role_storage = ?, xftp_role_proxy = ? WHERE server_operator_id = ? |] - (tradeName, legalName, T.intercalate "," serverDomains, BI enabled, BI (storage smpRoles), BI (proxy smpRoles), BI (names smpRoles), BI (storage xftpRoles), BI (proxy xftpRoles), operatorId) + (tradeName, legalName, T.intercalate "," serverDomains, BI enabled, BI smpStorage, BI smpProxy, BI smpNames, BI xftpStorage, BI xftpProxy, operatorId) + where + ServerRoles {storage = smpStorage, proxy = smpProxy, names = smpNames} = smpRoles + ServerRoles {storage = xftpStorage, proxy = xftpProxy} = xftpRoles insertOperator :: NewServerOperator -> IO ServerOperator insertOperator op@ServerOperator {operatorTag, tradeName, legalName, serverDomains, enabled, smpRoles, xftpRoles} = do DB.execute @@ -820,9 +833,12 @@ getUpdateServerOperators db presetOps newUser = do (server_operator_tag, trade_name, legal_name, server_domains, enabled, smp_role_storage, smp_role_proxy, smp_role_names, xftp_role_storage, xftp_role_proxy) VALUES (?,?,?,?,?,?,?,?,?,?) |] - (operatorTag, tradeName, legalName, T.intercalate "," serverDomains, BI enabled, BI (storage smpRoles), BI (proxy smpRoles), BI (names smpRoles), BI (storage xftpRoles), BI (proxy xftpRoles)) + (operatorTag, tradeName, legalName, T.intercalate "," serverDomains, BI enabled, BI smpStorage, BI smpProxy, BI smpNames, BI xftpStorage, BI xftpProxy) opId <- insertedRowId db pure op {operatorId = DBEntityId opId} + where + ServerRoles {storage = smpStorage, proxy = smpProxy, names = smpNames} = smpRoles + ServerRoles {storage = xftpStorage, proxy = xftpProxy} = xftpRoles autoAcceptConditions op UsageConditions {conditionsCommit} now = acceptConditions_ db op conditionsCommit now True $> op {conditionsAcceptance = CAAccepted (Just now) True} diff --git a/src/Simplex/Chat/Store/SQLite/Migrations.hs b/src/Simplex/Chat/Store/SQLite/Migrations.hs index f9a27f93af..7fc18617e7 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations.hs @@ -167,6 +167,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260707_file_digest import Simplex.Chat.Store.SQLite.Migrations.M20260714_member_security_code import Simplex.Chat.Store.SQLite.Migrations.M20260715_profile_description import Simplex.Chat.Store.SQLite.Migrations.M20260716_signed_history +import Simplex.Chat.Store.SQLite.Migrations.M20260720_server_roles import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -333,7 +334,8 @@ schemaMigrations = ("20260707_file_digest", m20260707_file_digest, Just down_m20260707_file_digest), ("20260714_member_security_code", m20260714_member_security_code, Just down_m20260714_member_security_code), ("20260715_profile_description", m20260715_profile_description, Just down_m20260715_profile_description), - ("20260716_signed_history", m20260716_signed_history, Just down_m20260716_signed_history) + ("20260716_signed_history", m20260716_signed_history, Just down_m20260716_signed_history), + ("20260720_server_roles", m20260720_server_roles, Just down_m20260720_server_roles) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20260720_server_roles.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20260720_server_roles.hs new file mode 100644 index 0000000000..ca6982593a --- /dev/null +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20260720_server_roles.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.SQLite.Migrations.M20260720_server_roles where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20260720_server_roles :: Query +m20260720_server_roles = + [sql| +ALTER TABLE protocol_servers ADD COLUMN role_storage INTEGER; +ALTER TABLE protocol_servers ADD COLUMN role_proxy INTEGER; +ALTER TABLE protocol_servers ADD COLUMN role_names INTEGER; +|] + +down_m20260720_server_roles :: Query +down_m20260720_server_roles = + [sql| +ALTER TABLE protocol_servers DROP COLUMN role_storage; +ALTER TABLE protocol_servers DROP COLUMN role_proxy; +ALTER TABLE protocol_servers DROP COLUMN role_names; +|] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index 1c5a5bb445..e42b537225 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql @@ -565,6 +565,9 @@ CREATE TABLE IF NOT EXISTS "protocol_servers"( created_at TEXT NOT NULL DEFAULT(datetime('now')), updated_at TEXT NOT NULL DEFAULT(datetime('now')), protocol TEXT NOT NULL DEFAULT 'smp', + role_storage INTEGER, + role_proxy INTEGER, + role_names INTEGER, UNIQUE(user_id, host, port) ) STRICT; CREATE TABLE xftp_file_descriptions( diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index c136a08c7d..3cf7554cf5 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1659,12 +1659,12 @@ viewUserServers UserOperatorServers {operator, smpServers, xftpServers, chatRela testedInfo = maybe [] (\t -> ["test: " <> if t then "passed" else "failed"]) tested viewRoles op@ServerOperator {enabled} | not enabled = "disabled" - | storage rs && proxy rs = "enabled" - | storage rs = "enabled storage" - | proxy rs = "enabled proxy" + | rStorage && rProxy = "enabled" + | rStorage = "enabled storage" + | rProxy = "enabled proxy" | otherwise = "disabled (servers known)" where - rs = operatorRoles p op + ServerRoles {storage = rStorage, proxy = rProxy} = operatorRoles p op viewChatRelays :: [UserChatRelay] -> [StyledString] viewChatRelays [] = [] viewChatRelays cRelays @@ -1752,12 +1752,12 @@ viewOpEnabled ServerOperator {enabled, smpRoles, xftpRoles} | both smpRoles && both xftpRoles = "enabled" | otherwise = "SMP " <> viewRoles smpRoles <> ", XFTP " <> viewRoles xftpRoles where - no rs = not $ storage rs || proxy rs - both rs = storage rs && proxy rs - viewRoles rs + no ServerRoles {storage, proxy} = not $ storage || proxy + both ServerRoles {storage, proxy} = storage && proxy + viewRoles rs@ServerRoles {storage, proxy} | both rs = "enabled" - | storage rs = "enabled storage" - | proxy rs = "enabled proxy" + | storage = "enabled storage" + | proxy = "enabled proxy" | otherwise = "disabled (servers known)" viewConditionsAction :: UsageConditionsAction -> [StyledString] diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 029c637980..77d91bf522 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -23,15 +24,17 @@ import Control.Monad.Except import Control.Monad.Reader import Data.Functor (($>)) import Data.List (dropWhileEnd, find) +import qualified Data.List.NonEmpty as L import Data.Maybe (isNothing) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (getCurrentTime) import Network.Socket import Simplex.Chat -import Simplex.Chat.Controller (ChatCommand (..), ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..), WebPreviewConfig (..), defaultSimpleNetCfg) +import Simplex.Chat.Controller (ChatCommand (..), ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..), ChatResponse (..), WebPreviewConfig (..), defaultSimpleNetCfg) import Simplex.Chat.Core import Simplex.Chat.Library.Commands +import Simplex.Chat.Operators import Simplex.Chat.Options import Simplex.Chat.Options.DB import Simplex.Chat.Protocol (currentChatVersion, pqEncryptionCompressionVersion) @@ -50,6 +53,7 @@ import Simplex.Messaging.Agent (disposeAgentClient) import Simplex.Messaging.Agent.Env.SQLite import Simplex.Messaging.Agent.Protocol (currentSMPAgentVersion, duplexHandshakeSMPAgentVersion, pqdrSMPAgentVersion, supportedSMPAgentVRange) import Simplex.Messaging.Agent.RetryInterval +import Simplex.Messaging.Agent.Store.Entity (SDBStored (..)) import Simplex.Messaging.Agent.Store.Interface (closeDBStore) import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationConfirmation (..), MigrationError) import qualified Simplex.Messaging.Agent.Store.DB as DB @@ -57,6 +61,7 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..)) import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig) import Simplex.Messaging.Crypto.Ratchet (supportedE2EEncryptVRange) import qualified Simplex.Messaging.Crypto.Ratchet as CR +import Simplex.Messaging.Protocol (ProtocolType (..)) import Simplex.Messaging.Server (runSMPServerBlocking) import Simplex.Messaging.Server.Env.STM (ServerConfig (..), ServerStoreCfg (..), StartOptions (..), StorePaths (..), defaultMessageExpiration, defaultIdleQueueInterval, defaultNtfExpiration, defaultInactiveClientExpiration) import NameResolver (NameRegistry, resolverNamesConfig, withNameResolver) @@ -394,6 +399,26 @@ withTestChatCfgOpts ps cfg opts dbPrefix = bracket (startTestChat ps cfg opts db withTestOutput :: HasCallStack => (HasCallStack => TestParams -> IO ()) -> TestParams -> IO () withTestOutput test ps = test ps {printOutput = True} +-- Opt the client's SMP servers into name resolution (self-hosted servers default names off). +enableNamesRole :: HasCallStack => TestCC -> IO () +enableNamesRole TestCC {chatController = cc} = do + r <- execChatCommand' (APIGetUserServers 1) 0 `runReaderT` cc + case r of + Right (CRUserServers _ uoss) -> do + r' <- execChatCommand' (APISetUserServers 1 (L.fromList (map toUpdated uoss))) 0 `runReaderT` cc + either (fail . show) (const $ pure ()) r' + Right other -> fail $ "enableNamesRole: unexpected response " <> show other + Left e -> fail $ "enableNamesRole: APIGetUserServers failed " <> show e + where + toUpdated UserOperatorServers {operator, smpServers, xftpServers, chatRelays} = + UpdatedUserOperatorServers + { operator, + smpServers = map (AUS SDBStored . enableNames) smpServers, + xftpServers = map (AUS SDBStored) xftpServers, + chatRelays = map (AUCR SDBStored) chatRelays + } + enableNames srv@UserServer {roles} = (srv :: UserServer 'PSMP) {roles = (roles :: ServerRolesOverride) {names = Just True}} + readTerminalOutput :: VirtualTerminal -> TQueue String -> IO () readTerminalOutput t termQ = do let w = virtualWindow t diff --git a/tests/ChatTests/Names.hs b/tests/ChatTests/Names.hs index ce0343800c..46b62801fe 100644 --- a/tests/ChatTests/Names.hs +++ b/tests/ChatTests/Names.hs @@ -33,6 +33,7 @@ testConnectByName ps = withSmpServerAndNames $ \reg -> where aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" []) test reg alice bob = do + mapM_ enableNamesRole [alice, bob] alice ##> "/ad" (shortLink, _) <- getContactLinks alice True registerName reg aliceName (contactNameRecord "alice" (T.pack shortLink)) @@ -67,6 +68,7 @@ testConnectByNameNotClaimed ps = withSmpServerAndNames $ \reg -> where aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" []) test reg alice bob = do + mapM_ enableNamesRole [alice, bob] alice ##> "/ad" (shortLink, _) <- getContactLinks alice True registerName reg aliceName (contactNameRecord "alice" (T.pack shortLink)) @@ -79,6 +81,7 @@ testConnectByNameKnownContactNotClaimed ps = withSmpServerAndNames $ \reg -> where aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" []) test reg alice bob = do + mapM_ enableNamesRole [alice, bob] alice ##> "/ad" (shortLink, _) <- getContactLinks alice True bob ##> ("/c " <> shortLink) @@ -100,6 +103,7 @@ testConnectByNameNotFound ps = withSmpServerAndNames $ \_reg -> testChat2 aliceProfile bobProfile test ps where test _alice bob = do + enableNamesRole bob bob ##> "/c @nobody.simplex" bob .<## "smpErr = NAME {nameErr = NOT_FOUND}}" @@ -109,6 +113,7 @@ testSetNameNotOwnAddress ps = withSmpServerAndNames $ \reg -> where aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" []) test reg alice bob = do + mapM_ enableNamesRole [alice, bob] bob ##> "/ad" (bobShortLink, _) <- getContactLinks bob True registerName reg aliceName (contactNameRecord "alice" (T.pack bobShortLink)) @@ -123,6 +128,7 @@ testChannelDomainLinkJoinUnverified ps = withSmpServerAndNames $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do + mapM_ enableNamesRole [alice, cath, bob] (shortLink, fullLink) <- prepareChannel1Relay "team" alice cath registerName reg teamName (channelNameRecord "team" (T.pack shortLink)) alice ##> "/public group access #team domain=team.simplex" @@ -142,6 +148,7 @@ testChannelDomainVerify ps = withSmpServerAndNames $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do + mapM_ enableNamesRole [alice, cath, bob] (shortLink, fullLink) <- prepareChannel1Relay "team" alice cath registerName reg teamName (channelNameRecord "team" (T.pack shortLink)) alice ##> "/public group access #team domain=team.simplex" @@ -171,6 +178,7 @@ testConnectByChannelName ps = withSmpServerAndNames $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do + mapM_ enableNamesRole [alice, cath, bob] (shortLink, _) <- prepareChannel1Relay "team" alice cath registerName reg teamName (channelNameRecord "team" (T.pack shortLink)) alice ##> "/public group access #team domain=team.simplex" @@ -204,6 +212,7 @@ testConnectByNameChannelAndContact ps = withSmpServerAndNames $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do + mapM_ enableNamesRole [alice, cath, bob] (channelLink, _) <- prepareChannel1Relay "team" alice cath alice ##> "/ad" (contactLink, _) <- getContactLinks alice True @@ -242,6 +251,7 @@ testConnectByNameContactAndChannel ps = withSmpServerAndNames $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do + mapM_ enableNamesRole [alice, cath, bob] (channelLink, _) <- prepareChannel1Relay "acme" alice cath alice ##> "/ad" (contactLink, _) <- getContactLinks alice True @@ -260,6 +270,7 @@ testConnectByNameBusinessAndChannel ps = withSmpServerAndNames $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do + mapM_ enableNamesRole [alice, cath, bob] (channelLink, _) <- prepareChannel1Relay "biz" alice cath alice ##> "/ad" (contactLink, fullLink) <- getContactLinks alice True diff --git a/tests/OperatorTests.hs b/tests/OperatorTests.hs index d0b48a9019..c7ce5e8206 100644 --- a/tests/OperatorTests.hs +++ b/tests/OperatorTests.hs @@ -23,7 +23,7 @@ import Simplex.Chat.Operators.Presets import Simplex.Chat.Protocol (RelayProfile (..), mkRelayProfile) import Simplex.Chat.Types import Simplex.FileTransfer.Client.Presets (defaultXFTPServers) -import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..), allRoles) +import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles) import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol @@ -33,6 +33,7 @@ operatorTests :: Spec operatorTests = describe "managing server operators" $ do validateServersTest updatedServersTest + perServerRolesTest validateServersTest :: Spec validateServersTest = describe "validate user servers" $ do @@ -122,6 +123,84 @@ updatedServersTest = describe "validate user servers" $ do PresetServers {operators} = presetServers defaultChatConfig customRelayAddr = either error id $ strDecode "https://relay.example.im/r#Pz9qz7ZVljMofoRxiDDpL_w2DZSazK8IgafxqnWKv6Y" +perServerRolesTest :: Spec +perServerRolesTest = describe "per-server roles" $ do + describe "agentServerCfgs resolution" $ do + it "self-hosted server keeps its per-server roles" $ + case agentServerCfgs SPSMP opDomains [selfHostedSMP (ServerRolesOverride (Just True) (Just False) (Just True))] of + [ServerCfg {operator, roles}] -> do + operator `shouldBe` Nothing + rolesTuple roles `shouldBe` (True, False, True) + cfgs -> expectationFailure $ "expected one self-hosted ServerCfg, got: " <> show cfgs + it "self-hosted server without roles falls back to default roles" $ + case agentServerCfgs SPSMP opDomains [selfHostedSMP emptyServerRolesOverride] of + [ServerCfg {operator, roles}] -> do + operator `shouldBe` Nothing + rolesTuple roles `shouldBe` (True, True, False) + cfgs -> expectationFailure $ "expected one self-hosted ServerCfg, got: " <> show cfgs + it "self-hosted partial override keeps defaults for unset roles" $ + case agentServerCfgs SPSMP opDomains [selfHostedSMP (ServerRolesOverride Nothing Nothing (Just True))] of + [ServerCfg {operator, roles}] -> do + operator `shouldBe` Nothing + rolesTuple roles `shouldBe` (True, True, True) + cfgs -> expectationFailure $ "expected one self-hosted ServerCfg, got: " <> show cfgs + it "self-hosted explicit No overrides a default-yes role" $ + case agentServerCfgs SPSMP opDomains [selfHostedSMP (ServerRolesOverride (Just False) Nothing Nothing)] of + [ServerCfg {operator, roles}] -> do + operator `shouldBe` Nothing + rolesTuple roles `shouldBe` (False, True, False) + cfgs -> expectationFailure $ "expected one self-hosted ServerCfg, got: " <> show cfgs + it "operator-matched server without override inherits operator roles" $ + -- operator roles are all on; no override -> all inherited, including names + case agentServerCfgs SPSMP opDomains [opMatchedSMP emptyServerRolesOverride] of + [ServerCfg {operator, roles}] -> do + operator `shouldBe` Just 1 + rolesTuple roles `shouldBe` (True, True, True) + cfgs -> expectationFailure $ "expected one operator-matched ServerCfg, got: " <> show cfgs + it "operator-matched server applies its override over operator roles" $ + -- operator roles are all on; override turns storage/names off, proxy inherits (on) + case agentServerCfgs SPSMP opDomains [opMatchedSMP (ServerRolesOverride (Just False) Nothing (Just False))] of + [ServerCfg {operator, roles}] -> do + operator `shouldBe` Just 1 + rolesTuple roles `shouldBe` (False, True, False) + cfgs -> expectationFailure $ "expected one operator-matched ServerCfg, got: " <> show cfgs + it "two self-hosted servers resolve their three roles independently" $ + -- agentServerCfgs preserves input order + let a = (newUserServer "smp://abcd@self.example.com" :: NewUserServer 'PSMP) {roles = ServerRolesOverride (Just False) (Just True) (Just True)} + b = (newUserServer "smp://abcd@self2.example.com" :: NewUserServer 'PSMP) {roles = ServerRolesOverride (Just True) (Just False) Nothing} + in case agentServerCfgs SPSMP opDomains [a, b] of + [ServerCfg {operator = opA, roles = rolesA}, ServerCfg {operator = opB, roles = rolesB}] -> do + (opA, opB) `shouldBe` (Nothing, Nothing) + rolesTuple rolesA `shouldBe` (False, True, True) + rolesTuple rolesB `shouldBe` (True, False, False) + cfgs -> expectationFailure $ "expected two self-hosted ServerCfgs, got: " <> show cfgs + describe "validateUserServers per-server names coverage" $ do + it "self-hosted-only user without names servers warns USWNoNamesServers" $ do + let (_errs, warns) = validateUserServers [selfHostedUser emptyServerRolesOverride] [] + warns `shouldSatisfy` elem (USWNoNamesServers Nothing) + it "self-hosted user with a names server does not warn USWNoNamesServers" $ do + let (_errs, warns) = validateUserServers [selfHostedUser (ServerRolesOverride Nothing Nothing (Just True))] [] + warns `shouldSatisfy` notElem (USWNoNamesServers Nothing) + where + testOp = operatorSimpleXChat {operatorId = DBEntityId 1} + opDomains = operatorDomains [testOp] + -- host matches no operator domain -> self-hosted + selfHostedSMP :: ServerRolesOverride -> NewUserServer 'PSMP + selfHostedSMP r = (newUserServer "smp://abcd@self.example.com" :: NewUserServer 'PSMP) {roles = r} + -- host matches operator domain simplex.im + opMatchedSMP :: ServerRolesOverride -> NewUserServer 'PSMP + opMatchedSMP r = (newUserServer "smp://abcd@smp8.simplex.im" :: NewUserServer 'PSMP) {roles = r} + selfHostedUser :: ServerRolesOverride -> UpdatedUserOperatorServers + selfHostedUser r = + UpdatedUserOperatorServers + { operator = Nothing, + smpServers = [AUS SDBNew $ selfHostedSMP r], + xftpServers = [], + chatRelays = [] + } + rolesTuple :: ServerRoles -> (Bool, Bool, Bool) + rolesTuple ServerRoles {storage, proxy, names} = (storage, proxy, names) + deriving instance Eq User deriving instance Eq UserServersError