core: different roles for different protocols (#5185)

* core: different roles for different protocols * include current conditions in responses * fix * fix test * fix --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
2026-03-30 22:55:48 +00:00 · 2024-11-15 12:08:15 +00:00
parent ff8e29c0eb
commit feb687d3b8
8 changed files with 104 additions and 65 deletions
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -150,7 +150,8 @@ operatorSimpleXChat =
      serverDomains = ["simplex.im"],
      conditionsAcceptance = CARequired Nothing,
      enabled = True,
-      roles = allRoles
+      smpRoles = allRoles,
+      xftpRoles = allRoles
    }

 operatorFlux :: NewServerOperator
@@ -163,7 +164,8 @@ operatorFlux =
      serverDomains = ["simplexonflux.com"],
      conditionsAcceptance = CARequired Nothing,
      enabled = False,
-      roles = ServerRoles {storage = False, proxy = True}
+      smpRoles = ServerRoles {storage = False, proxy = True},
+      xftpRoles = allRoles
    }

 defaultChatConfig :: ChatConfig
@@ -420,7 +422,7 @@ newChatController
          getServers p users opDomains = do
            let rs' = rndServers p rs
            fmap M.fromList $ forM users $ \u ->
-              (aUserId u,) . agentServerCfgs opDomains rs' <$> getUpdateUserServers db p presetOps rs' u
+              (aUserId u,) . agentServerCfgs p opDomains rs' <$> getUpdateUserServers db p presetOps rs' u

 updateNetworkConfig :: NetworkConfig -> SimpleNetCfg -> NetworkConfig
 updateNetworkConfig cfg SimpleNetCfg {socksProxy, socksMode, hostMode, requiredHostMode, smpProxyMode_, smpProxyFallback_, smpWebPort, tcpTimeout_, logTLSErrors} =
@@ -643,10 +645,10 @@ processChatCommand' vr = \case
    forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash} ->
      when (n == displayName) . throwChatError $
        if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""}
-    opDomains <- operatorDomains . fst <$> withFastStore getServerOperators
+    opDomains <- operatorDomains . serverOperators <$> withFastStore getServerOperators
    rs <- asks randomServers
-    let smp = agentServerCfgs opDomains (rndServers SPSMP rs) smpServers
-        xftp = agentServerCfgs opDomains (rndServers SPXFTP rs) xftpServers
+    let smp = agentServerCfgs SPSMP opDomains (rndServers SPSMP rs) smpServers
+        xftp = agentServerCfgs SPXFTP opDomains (rndServers SPXFTP rs) xftpServers
    auId <- withAgent (\a -> createUser a smp xftp)
    ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure
    user <- withFastStore $ \db -> createUserRecordAt db (AgentUserId auId) p True ts
@@ -1601,10 +1603,10 @@ processChatCommand' vr = \case
    lift $ CRServerTestResult user srv <$> withAgent' (\a -> testProtocolServer a (aUserId user) server)
  TestProtoServer srv -> withUser $ \User {userId} ->
    processChatCommand $ APITestProtoServer userId srv
-  APIGetServerOperators -> uncurry CRServerOperators <$> withFastStore getServerOperators
+  APIGetServerOperators -> CRServerOperatorConditions <$> withFastStore getServerOperators
  APISetServerOperators operatorsEnabled -> withFastStore $ \db -> do
    liftIO $ setServerOperators db operatorsEnabled
-    uncurry CRServerOperators <$> getServerOperators db
+    CRServerOperatorConditions <$> getServerOperators db
  APIGetUserServers userId -> withUserId userId $ \user -> withFastStore $ \db ->
    CRUserServers user <$> (liftIO . groupByOperator =<< getUserServers db user)
  APISetUserServers userId userServers -> withUserId userId $ \user -> do
@@ -1617,8 +1619,8 @@ processChatCommand' vr = \case
    rs <- asks randomServers
    lift $ withAgent' $ \a -> do
      let auId = aUserId user
-      setProtocolServers a auId $ agentServerCfgs opDomains (rndServers SPSMP rs) smpServers
-      setProtocolServers a auId $ agentServerCfgs opDomains (rndServers SPXFTP rs) xftpServers
+      setProtocolServers a auId $ agentServerCfgs SPSMP opDomains (rndServers SPSMP rs) smpServers
+      setProtocolServers a auId $ agentServerCfgs SPXFTP opDomains (rndServers SPXFTP rs) xftpServers
    ok_
  APIValidateServers userId userServers -> withUserId userId $ \user ->
    CRUserServersValidation user <$> validateAllUsersServers userId userServers
@@ -1641,7 +1643,7 @@ processChatCommand' vr = \case
  APIAcceptConditions condId opIds -> withFastStore $ \db -> do
    currentTs <- liftIO getCurrentTime
    acceptConditions db condId opIds currentTs
-    uncurry CRServerOperators <$> getServerOperators db
+    CRServerOperatorConditions <$> getServerOperators db
  APISetChatItemTTL userId newTTL_ -> withUserId userId $ \user ->
    checkStoreNotChanged $
      withChatLock "setChatItemTTL" $ do
@@ -3777,9 +3779,9 @@ getKnownAgentServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p ->
 getKnownAgentServers p user = do
  rs <- asks randomServers
  withStore $ \db -> do
-    opDomains <- operatorDomains . fst <$> getServerOperators db
+    opDomains <- operatorDomains . serverOperators <$> getServerOperators db
    srvs <- liftIO $ getProtocolServers db p user
-    pure $ L.toList $ agentServerCfgs opDomains (rndServers p rs) srvs
+    pure $ L.toList $ agentServerCfgs p opDomains (rndServers p rs) srvs

 protoServer' :: ServerCfg p -> ProtocolServer p
 protoServer' ServerCfg {server} = protoServer server
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -588,7 +588,7 @@ data ChatResponse
  | CRChatItemId User (Maybe ChatItemId)
  | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
  | CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure}
-  | CRServerOperators {operators :: [ServerOperator], conditionsAction :: Maybe UsageConditionsAction}
+  | CRServerOperatorConditions {conditions :: ServerOperatorConditions}
  | CRUserServers {user :: User, userServers :: [UserOperatorServers]}
  | CRUserServersValidation {user :: User, serverErrors :: [UserServersError]}
  | CRUsageConditions {usageConditions :: UsageConditions, conditionsText :: Text, acceptedConditions :: Maybe UsageConditions}
--- a/src/Simplex/Chat/Migrations/M20241027_server_operators.hs
+++ b/src/Simplex/Chat/Migrations/M20241027_server_operators.hs
@@ -15,8 +15,10 @@ CREATE TABLE server_operators (
  legal_name TEXT,
  server_domains TEXT,
  enabled INTEGER NOT NULL DEFAULT 1,
-  role_storage INTEGER NOT NULL DEFAULT 1,
-  role_proxy INTEGER NOT NULL DEFAULT 1,
+  smp_role_storage INTEGER NOT NULL DEFAULT 1,
+  smp_role_proxy INTEGER NOT NULL DEFAULT 1,
+  xftp_role_storage INTEGER NOT NULL DEFAULT 1,
+  xftp_role_proxy INTEGER NOT NULL DEFAULT 1,
  created_at TEXT NOT NULL DEFAULT (datetime('now')),
  updated_at TEXT NOT NULL DEFAULT (datetime('now'))
 );
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -596,8 +596,10 @@ CREATE TABLE server_operators(
  legal_name TEXT,
  server_domains TEXT,
  enabled INTEGER NOT NULL DEFAULT 1,
-  role_storage INTEGER NOT NULL DEFAULT 1,
-  role_proxy INTEGER NOT NULL DEFAULT 1,
+  smp_role_storage INTEGER NOT NULL DEFAULT 1,
+  smp_role_proxy INTEGER NOT NULL DEFAULT 1,
+  xftp_role_storage INTEGER NOT NULL DEFAULT 1,
+  xftp_role_proxy INTEGER NOT NULL DEFAULT 1,
  created_at TEXT NOT NULL DEFAULT(datetime('now')),
  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
--- a/src/Simplex/Chat/Operators.hs
+++ b/src/Simplex/Chat/Operators.hs
@@ -134,6 +134,13 @@ data UsageConditionsAction
  | UCAAccepted {operators :: [ServerOperator]}
  deriving (Show)

+data ServerOperatorConditions = ServerOperatorConditions
+  { serverOperators :: [ServerOperator],
+    currentConditions :: UsageConditions,
+    conditionsAction :: Maybe UsageConditionsAction
+  }
+  deriving (Show)
+
 usageConditionsAction :: [ServerOperator] -> UsageConditions -> UTCTime -> Maybe UsageConditionsAction
 usageConditionsAction operators UsageConditions {createdAt, notifiedAt} now = do
  let enabledOperators = filter (\ServerOperator {enabled} -> enabled) operators
@@ -178,10 +185,16 @@ data ServerOperator' s = ServerOperator
    serverDomains :: [Text],
    conditionsAcceptance :: ConditionsAcceptance,
    enabled :: Bool,
-    roles :: ServerRoles
+    smpRoles :: ServerRoles,
+    xftpRoles :: ServerRoles
  }
  deriving (Show)

+operatorRoles :: UserProtocol p => SProtocolType p -> ServerOperator -> ServerRoles
+operatorRoles p op = case p of
+  SPSMP -> smpRoles op
+  SPXFTP -> xftpRoles op
+
 conditionsAccepted :: ServerOperator -> Bool
 conditionsAccepted ServerOperator {conditionsAcceptance} = case conditionsAcceptance of
  CAAccepted {} -> True
@@ -336,8 +349,8 @@ updatedServerOperators presetOps storedOps =
      Just presetOp -> (storedOp' :)
        where
          storedOp' = case find ((operatorTag presetOp ==) . operatorTag) storedOps of
-            Just ServerOperator {operatorId, conditionsAcceptance, enabled, roles} ->
-              ASO SDBStored presetOp {operatorId, conditionsAcceptance, enabled, roles}
+            Just ServerOperator {operatorId, conditionsAcceptance, enabled, smpRoles, xftpRoles} ->
+              ASO SDBStored presetOp {operatorId, conditionsAcceptance, enabled, smpRoles, xftpRoles}
            Nothing -> ASO SDBNew presetOp

 -- This function should be used inside DB transaction to update servers.
@@ -361,8 +374,8 @@ updatedUserServers p presetOps randomSrvs srvs =
 srvHost :: UserServer' s p -> NonEmpty TransportHost
 srvHost UserServer {server = ProtoServerWithAuth srv _} = host srv

-agentServerCfgs :: [(Text, ServerOperator)] -> NonEmpty (NewUserServer p) -> [UserServer' s p] -> NonEmpty (ServerCfg p)
-agentServerCfgs opDomains randomSrvs =
+agentServerCfgs :: UserProtocol p => SProtocolType p -> [(Text, ServerOperator)] -> NonEmpty (NewUserServer p) -> [UserServer' s p] -> NonEmpty (ServerCfg p)
+agentServerCfgs p opDomains randomSrvs =
  fromMaybe fallbackSrvs . L.nonEmpty . mapMaybe enabledOpAgentServer
  where
    fallbackSrvs = L.map (snd . agentServer) randomSrvs
@@ -372,8 +385,8 @@ agentServerCfgs opDomains randomSrvs =
    agentServer :: UserServer' s p -> (Bool, ServerCfg p)
    agentServer srv@UserServer {server, enabled} =
      case find (\(d, _) -> any (matchingHost d) (srvHost srv)) opDomains of
-        Just (_, ServerOperator {operatorId = DBEntityId opId, enabled = opEnabled, roles}) ->
-          (opEnabled, ServerCfg {server, enabled, operator = Just opId, roles})
+        Just (_, op@ServerOperator {operatorId = DBEntityId opId, enabled = opEnabled}) ->
+          (opEnabled, ServerCfg {server, enabled, operator = Just opId, roles = operatorRoles p op})
        Nothing ->
          (True, ServerCfg {server, enabled, operator = Nothing, roles = allRoles})

@@ -423,7 +436,7 @@ validateUserServers curr others = currUserErrs <> concatMap otherUserErrs others
        p' = AProtocolType p
        noServers cond = not $ any srvEnabled $ snd $ partitionValid $ concatMap (`servers'` p) $ filter cond uss
        opEnabled = maybe True (\ServerOperator {enabled} -> enabled) . operator'
-        hasRole roleSel = maybe True (\ServerOperator {enabled, roles} -> enabled && roleSel roles) . operator'
+        hasRole roleSel = maybe True (\op@ServerOperator {enabled} -> enabled && roleSel (operatorRoles p op)) . operator'
        srvEnabled (AUS _ UserServer {deleted, enabled}) = enabled && not deleted
    serverErrs :: (UserServersClass u, ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [u] -> [UserServersError]
    serverErrs p uss = map (USEInvalidServer p') invalidSrvs <> mapMaybe duplicateErr_ srvs
@@ -472,6 +485,8 @@ instance DBStoredI s => FromJSON (ServerOperator' s) where

 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "UCA") ''UsageConditionsAction)

+$(JQ.deriveJSON defaultJSON ''ServerOperatorConditions)
+
 instance ProtocolTypeI p => ToJSON (UserServer' s p) where
  toEncoding = $(JQ.mkToEncoding defaultJSON ''UserServer_)
  toJSON = $(JQ.mkToJSON defaultJSON ''UserServer_)
--- a/src/Simplex/Chat/Store/Profiles.hs
+++ b/src/Simplex/Chat/Store/Profiles.hs
@@ -612,20 +612,21 @@ serverColumns p (ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_)
      auth = safeDecodeUtf8 . unBasicAuth <$> auth_
   in (protocol, host, port, keyHash, auth)

-getServerOperators :: DB.Connection -> ExceptT StoreError IO ([ServerOperator], Maybe UsageConditionsAction)
+getServerOperators :: DB.Connection -> ExceptT StoreError IO ServerOperatorConditions
 getServerOperators db = do
-  currentConds <- getCurrentUsageConditions db
+  currentConditions <- getCurrentUsageConditions db
  liftIO $ do
    now <- getCurrentTime
    latestAcceptedConds_ <- getLatestAcceptedConditions db
-    let getConds op = (\ca -> op {conditionsAcceptance = ca}) <$> getOperatorConditions_ db op currentConds latestAcceptedConds_ now
-    operators <- mapM getConds =<< getServerOperators_ db
-    pure (operators, usageConditionsAction operators currentConds now)
+    let getConds op = (\ca -> op {conditionsAcceptance = ca}) <$> getOperatorConditions_ db op currentConditions latestAcceptedConds_ now
+    ops <- mapM getConds =<< getServerOperators_ db
+    let conditionsAction = usageConditionsAction ops currentConditions now
+    pure ServerOperatorConditions {serverOperators = ops, currentConditions, conditionsAction}

 getUserServers :: DB.Connection -> User -> ExceptT StoreError IO ([ServerOperator], [UserServer 'PSMP],  [UserServer 'PXFTP])
 getUserServers db user =
  (,,)
-    <$> (fst <$> getServerOperators db)
+    <$> (serverOperators <$> getServerOperators db)
    <*> liftIO (getProtocolServers db SPSMP user)
    <*> liftIO (getProtocolServers db SPXFTP user)

@@ -635,15 +636,15 @@ setServerOperators db ops = do
  mapM_ (updateServerOperator db currentTs) ops

 updateServerOperator :: DB.Connection -> UTCTime -> ServerOperator -> IO ()
-updateServerOperator db currentTs ServerOperator {operatorId, enabled, roles = ServerRoles {storage, proxy}} =
+updateServerOperator db currentTs ServerOperator {operatorId, enabled, smpRoles, xftpRoles} =
  DB.execute
    db
    [sql|
      UPDATE server_operators
-      SET enabled = ?, role_storage = ?, role_proxy = ?, updated_at = ?
+      SET enabled = ?, smp_role_storage = ?, smp_role_proxy = ?, xftp_role_storage = ?, xftp_role_proxy = ?, updated_at = ?
      WHERE server_operator_id = ?
    |]
-    (enabled, storage, proxy, operatorId, currentTs)
+    (enabled, storage smpRoles, proxy smpRoles, storage xftpRoles, proxy xftpRoles, currentTs, operatorId)

 getUpdateServerOperators :: DB.Connection -> NonEmpty PresetOperator -> Bool -> IO [ServerOperator]
 getUpdateServerOperators db presetOps newUser = do
@@ -677,25 +678,25 @@ getUpdateServerOperators db presetOps newUser = do
        |]
        (conditionsId, conditionsCommit, notifiedAt, createdAt)
    updateOperator :: ServerOperator -> IO ()
-    updateOperator ServerOperator {operatorId, tradeName, legalName, serverDomains, enabled, roles = ServerRoles {storage, proxy}} =
+    updateOperator ServerOperator {operatorId, tradeName, legalName, serverDomains, enabled, smpRoles, xftpRoles} =
      DB.execute
        db
        [sql|
          UPDATE server_operators
-          SET trade_name = ?, legal_name = ?, server_domains = ?, enabled = ?, role_storage = ?, role_proxy = ?
+          SET trade_name = ?, legal_name = ?, server_domains = ?, enabled = ?, smp_role_storage = ?, smp_role_proxy = ?, xftp_role_storage = ?, xftp_role_proxy = ?
          WHERE server_operator_id = ?
        |]
-        (tradeName, legalName, T.intercalate "," serverDomains, enabled, storage, proxy, operatorId)
+        (tradeName, legalName, T.intercalate "," serverDomains, enabled, storage smpRoles, proxy smpRoles, storage xftpRoles, proxy xftpRoles, operatorId)
    insertOperator :: NewServerOperator -> IO ServerOperator
-    insertOperator op@ServerOperator {operatorTag, tradeName, legalName, serverDomains, enabled, roles = ServerRoles {storage, proxy}} = do
+    insertOperator op@ServerOperator {operatorTag, tradeName, legalName, serverDomains, enabled, smpRoles, xftpRoles} = do
      DB.execute
        db
        [sql|
          INSERT INTO server_operators
-            (server_operator_tag, trade_name, legal_name, server_domains, enabled, role_storage, role_proxy)
-          VALUES (?,?,?,?,?,?,?)
+            (server_operator_tag, trade_name, legal_name, server_domains, enabled, smp_role_storage, smp_role_proxy, xftp_role_storage, xftp_role_proxy)
+          VALUES (?,?,?,?,?,?,?,?,?)
        |]
-        (operatorTag, tradeName, legalName, T.intercalate "," serverDomains, enabled, storage, proxy)
+        (operatorTag, tradeName, legalName, T.intercalate "," serverDomains, enabled, storage smpRoles, proxy smpRoles, storage xftpRoles, proxy xftpRoles)
      opId <- insertedRowId db
      pure op {operatorId = DBEntityId opId}
    autoAcceptConditions op UsageConditions {conditionsCommit} =
@@ -706,15 +707,15 @@ serverOperatorQuery :: Query
 serverOperatorQuery =
  [sql|
    SELECT server_operator_id, server_operator_tag, trade_name, legal_name,
-      server_domains, enabled, role_storage, role_proxy
+      server_domains, enabled, smp_role_storage, smp_role_proxy, xftp_role_storage, xftp_role_proxy
    FROM server_operators
  |]

 getServerOperators_ :: DB.Connection -> IO [ServerOperator]
 getServerOperators_ db = map toServerOperator <$> DB.query_ db serverOperatorQuery

-toServerOperator :: (DBEntityId, Maybe OperatorTag, Text, Maybe Text, Text, Bool, Bool, Bool) -> ServerOperator
-toServerOperator (operatorId, operatorTag, tradeName, legalName, domains, enabled, storage, proxy) =
+toServerOperator :: (DBEntityId, Maybe OperatorTag, Text, Maybe Text, Text, Bool) :. (Bool, Bool) :. (Bool, Bool) -> ServerOperator
+toServerOperator ((operatorId, operatorTag, tradeName, legalName, domains, enabled) :. smpRoles' :. xftpRoles') =
  ServerOperator
    { operatorId,
      operatorTag,
@@ -723,8 +724,11 @@ toServerOperator (operatorId, operatorTag, tradeName, legalName, domains, enable
      serverDomains = T.splitOn "," domains,
      conditionsAcceptance = CARequired Nothing,
      enabled,
-      roles = ServerRoles {storage, proxy}
+      smpRoles = serverRoles smpRoles',
+      xftpRoles = serverRoles xftpRoles'
    }
+  where
+    serverRoles (storage, proxy) = ServerRoles {storage, proxy}

 getOperatorConditions_ :: DB.Connection -> ServerOperator -> UsageConditions -> Maybe UsageConditions -> UTCTime -> IO ConditionsAcceptance
 getOperatorConditions_ db ServerOperator {operatorId} UsageConditions {conditionsCommit = currentCommit, createdAt, notifiedAt} latestAcceptedConds_ now = do
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -65,7 +65,7 @@ import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON)
-import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType, ProtocolServer (..), ProtocolTypeI, SProtocolType (..))
+import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType, ProtocolServer (..), ProtocolTypeI, SProtocolType (..), UserProtocol)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
@@ -98,7 +98,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
  CRApiChat u chat _ -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat]
  CRApiParsedMarkdown ft -> [viewJSON ft]
  CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure
-  CRServerOperators ops ca -> viewServerOperators ops ca 
+  CRServerOperatorConditions (ServerOperatorConditions ops _ ca) -> viewServerOperators ops ca
  CRUserServers u uss -> ttyUser u $ concatMap viewUserServers uss <> (if testView then [] else serversUserHelp)
  CRUserServersValidation {} -> []
  CRUsageConditions {} -> []
@@ -1221,15 +1221,27 @@ viewUserServers UserOperatorServers {operator, smpServers, xftpServers} =
    <> viewServers SPSMP smpServers
    <> viewServers SPXFTP xftpServers
  where
-    viewServers :: ProtocolTypeI p => SProtocolType p -> [UserServer p] -> [StyledString]
+    viewServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [UserServer p] -> [StyledString]
    viewServers _ [] = []
-    viewServers p srvs = ["  " <> protocolName p <> " servers"] <> map (plain . ("    " <> ) . viewServer) srvs
+    viewServers p srvs
+      | maybe True (\ServerOperator {enabled} -> enabled) operator =
+          ["  " <> protocolName p <> " servers" <> maybe "" ((" " <>) . viewRoles) operator]
+            <> map (plain . ("    " <> ) . viewServer) srvs
+      | otherwise = []
      where
        viewServer UserServer {server, preset, tested, enabled} = safeDecodeUtf8 (strEncode server) <> serverInfo
          where
            serverInfo = if null serverInfo_ then "" else parens $ T.intercalate ", " serverInfo_
            serverInfo_ = ["preset" | preset] <> testedInfo <> ["disabled" | not enabled]
            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"
+          | otherwise = "disabled (servers known)"
+          where
+            rs = operatorRoles p op

 serversUserHelp :: [StyledString]
 serversUserHelp =
@@ -1272,8 +1284,8 @@ viewOperator op@ServerOperator {tradeName, legalName, serverDomains, conditionsA
    <> (", " <> viewOpEnabled op)

 shortViewOperator :: ServerOperator -> Text
-shortViewOperator op@ServerOperator {operatorId = DBEntityId opId, tradeName} =
-  tshow opId <> ". " <> tradeName <> parens (viewOpEnabled op)
+shortViewOperator ServerOperator {operatorId = DBEntityId opId, tradeName, enabled} =
+  tshow opId <> ". " <> tradeName <> parens (if enabled then "enabled" else "disabled")

 viewOpIdTag :: ServerOperator' s -> Text
 viewOpIdTag ServerOperator {operatorId, operatorTag} = case operatorId of
@@ -1290,11 +1302,19 @@ viewOpConditions = \case
    viewCond w ts = w <> maybe "" (parens . tshow) ts

 viewOpEnabled :: ServerOperator' s -> Text
-viewOpEnabled ServerOperator {enabled, roles = ServerRoles {storage, proxy}}
-  | enabled && storage && proxy = "enabled"
-  | enabled && storage = "enabled storage"
-  | enabled && proxy = "enabled proxy"
-  | otherwise = "disabled"
+viewOpEnabled ServerOperator {enabled, smpRoles, xftpRoles}
+  | not enabled = "disabled"
+  | no smpRoles && no xftpRoles = "disabled (servers known)"
+  | 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
+      | both rs = "enabled"
+      | storage rs = "enabled storage"
+      | proxy rs = "enabled proxy"
+      | otherwise = "disabled (servers known)"

 viewConditionsAction :: UsageConditionsAction -> [StyledString]
 viewConditionsAction = \case
@@ -1382,12 +1402,6 @@ viewConnectionStats ConnectionStats {rcvQueuesInfo, sndQueuesInfo} =
  ["receiving messages via: " <> viewRcvQueuesInfo rcvQueuesInfo | not $ null rcvQueuesInfo]
    <> ["sending messages via: " <> viewSndQueuesInfo sndQueuesInfo | not $ null sndQueuesInfo]

-- viewServers :: ProtocolTypeI p => [ServerOperator] -> NonEmpty (ServerCfg p) -> [StyledString]
-- viewServers operators = map (plain . (\ServerCfg {server, operator} -> B.unpack (strEncode server) <> viewOperator operator)) . L.toList
--   where
--     ops :: Map (Maybe DBEntityId) Text = foldl' (\m ServerOperator {operatorId, tradeName} -> M.insert (Just operatorId) tradeName m) M.empty operators
--     viewOperator = maybe "" $ \op -> " (operator " <> maybe (show op) T.unpack (M.lookup (Just op) ops) <> ")"
-
 viewRcvQueuesInfo :: [RcvQueueInfo] -> StyledString
 viewRcvQueuesInfo = plain . intercalate ", " . map showQueueInfo
  where
--- a/tests/OperatorTests.hs
+++ b/tests/OperatorTests.hs
@@ -29,7 +29,7 @@ validateServers = describe "validate user servers" $ do
    validateUserServers [invalidDisabled] [] `shouldBe` [USENoServers aSMP Nothing]
    validateUserServers [invalidDisabledOp] [] `shouldBe` [USENoServers aSMP Nothing, USENoServers aXFTP Nothing]
  it "should fail without servers with storage role" $ do
-    validateUserServers [invalidNoStorage] [] `shouldBe` [USEStorageMissing aSMP Nothing, USEStorageMissing aXFTP Nothing]
+    validateUserServers [invalidNoStorage] [] `shouldBe` [USEStorageMissing aSMP Nothing]
  it "should fail with duplicate host" $ do
    validateUserServers [invalidDuplicate] [] `shouldBe`
      [ USEDuplicateServer aSMP "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion" "smp8.simplex.im",
@@ -71,7 +71,7 @@ invalidDisabledOp =
 invalidNoStorage :: UpdatedUserOperatorServers
 invalidNoStorage =
  (valid :: UpdatedUserOperatorServers)
-    { operator = Just operatorSimpleXChat {operatorId = DBEntityId 1, roles = allRoles {storage = False}}
+    { operator = Just operatorSimpleXChat {operatorId = DBEntityId 1, smpRoles = allRoles {storage = False}}
    }

 invalidDuplicate :: UpdatedUserOperatorServers