core: add support for server operators (#4961)

* core: add support for server operators

* migration

* update schema and queries, rfc

* add usage conditions tables

* core: server operators new apis draft

* update

* conditions

* update

* add get conditions api

* add get conditions API

* WIP

* compiles

* fix schema

* core: ui logic in types (#5139)

* update

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

cabal.project

@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: ffecf200d4874dfa34f6d15b269964c0115a54ca
+    tag: ff05a465ee15ac7ae2c14a9fb703a18564950631
 
 source-repository-package
     type: git

docs/rfcs/2024-10-27-server-operators.md

@@ -0,0 +1,24 @@
+# Server operators
+
+## Problem
+
+All preconfigured servers operated by a single company create a risk that user connections can be analysed by aggregating transport information from these servers.
+
+The solution is to have more than one operator servers pre-configured in the app.
+
+For operators to be protected from any violations of rights of other users or third parties by the users who use servers of these operators, the users have to explicitely accept conditions of use with the operator, in the same way they accept conditions of use with SimpleX Chat Ltd by downloading the app.
+
+## Solution
+
+Allow to assign operators to servers, both with preconfigured operators and servers, and with user-defined operators. Agent added support for server roles, chat app could:
+- allow assigning server roles only on the operator level.
+- only on server level.
+- on both, with server roles overriding operator roles (that would require a different type for server for chat app).
+
+For simplicity of both UX and logic it is probably better to allow assigning roles only on operators' level, and servers without set operators can be used for both roles.
+
+For agreements, it is sufficient to record the signatures of these agreements on users' devices, together with the copy of signed agreement (or its hash and version) in a separate table. The terms themselves could be:
+- included in the app - either in code or in migration.
+- referenced with a stable link to a particular commit.
+
+The first solution seems better, as it avoids any third party dependency, and the agreement size is relatively small (~31kb), to reduce size we can store it compressed.

package.yaml

@@ -29,6 +29,7 @@ dependencies:
   - email-validate == 2.3.*
   - exceptions == 0.10.*
   - filepath == 1.4.*
+  - file-embed == 0.0.15.*
   - http-types == 0.12.*
   - http2 >= 4.2.2 && < 4.3
   - memory == 0.18.*

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."ffecf200d4874dfa34f6d15b269964c0115a54ca" = "0kb8hq37fc5g198wq7dswnlwjzk67q8rrzil2dii5lc6xfr47jbs";
+  "https://github.com/simplex-chat/simplexmq.git"."ff05a465ee15ac7ae2c14a9fb703a18564950631" = "1gv4nwqzbqkj7y3ffkiwkr4qwv52vdzppsds5vsfqaayl14rzmgp";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";

simplex-chat.cabal

@@ -150,10 +150,13 @@ library
       Simplex.Chat.Migrations.M20240920_user_order
       Simplex.Chat.Migrations.M20241008_indexes
       Simplex.Chat.Migrations.M20241010_contact_requests_contact_id
+      Simplex.Chat.Migrations.M20241027_server_operators
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared
       Simplex.Chat.Mobile.WebRTC
+      Simplex.Chat.Operators
+      Simplex.Chat.Operators.Conditions
       Simplex.Chat.Options
       Simplex.Chat.ProfileGenerator
       Simplex.Chat.Protocol
@@ -213,6 +216,7 @@ library
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*
+    , file-embed ==0.0.15.*
     , filepath ==1.4.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -276,6 +280,7 @@ executable simplex-bot
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*
+    , file-embed ==0.0.15.*
     , filepath ==1.4.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -340,6 +345,7 @@ executable simplex-bot-advanced
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*
+    , file-embed ==0.0.15.*
     , filepath ==1.4.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -407,6 +413,7 @@ executable simplex-broadcast-bot
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*
+    , file-embed ==0.0.15.*
     , filepath ==1.4.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -472,6 +479,7 @@ executable simplex-chat
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*
+    , file-embed ==0.0.15.*
     , filepath ==1.4.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -543,6 +551,7 @@ executable simplex-directory-service
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*
+    , file-embed ==0.0.15.*
     , filepath ==1.4.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -642,6 +651,7 @@ test-suite simplex-chat-test
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*
+    , file-embed ==0.0.15.*
     , filepath ==1.4.*
     , generic-random ==1.5.*
     , http-types ==0.12.*

src/Simplex/Chat.hs

@@ -67,6 +67,7 @@ import Simplex.Chat.Messages
 import Simplex.Chat.Messages.Batch (MsgBatch (..), batchMessages)
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Messages.CIContent.Events
+import Simplex.Chat.Operators
 import Simplex.Chat.Options
 import Simplex.Chat.ProfileGenerator (generateRandomProfile)
 import Simplex.Chat.Protocol
@@ -97,7 +98,7 @@ import qualified Simplex.FileTransfer.Transport as XFTP
 import Simplex.FileTransfer.Types (FileErrorType (..), RcvFileId, SndFileId)
 import Simplex.Messaging.Agent as Agent
 import Simplex.Messaging.Agent.Client (SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary, getFastNetworkConfig, ipAddressProtected, withLockMap)
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), ServerCfg (..), createAgentStore, defaultAgentConfig, enabledServerCfg, presetServerCfg)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), OperatorId, ServerCfg (..), allRoles, createAgentStore, defaultAgentConfig, enabledServerCfg, presetServerCfg)
 import Simplex.Messaging.Agent.Lock (withLock)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
@@ -152,7 +153,7 @@ defaultChatConfig =
           { smp = _defaultSMPServers,
             useSMP = 4,
             ntf = _defaultNtfServers,
-            xftp = L.map (presetServerCfg True) defaultXFTPServers,
+            xftp = L.map (presetServerCfg True allRoles operatorSimpleXChat) defaultXFTPServers,
             useXFTP = L.length defaultXFTPServers,
             netCfg = defaultNetworkConfig
           },
@@ -181,7 +182,7 @@ _defaultSMPServers :: NonEmpty (ServerCfg 'PSMP)
 _defaultSMPServers =
   L.fromList $
     map
-      (presetServerCfg True)
+      (presetServerCfg True allRoles operatorSimpleXChat)
       [ "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion",
         "smp://SkIkI6EPd2D63F4xFKfHk7I1UGZVNn6k1QWZ5rcyr6w=@smp9.simplex.im,jssqzccmrcws6bhmn77vgmhfjmhwlyr3u7puw4erkyoosywgl67slqqd.onion",
         "smp://6iIcWT_dF2zN_w5xzZEY7HI2Prbh3ldP07YTyDexPjE=@smp10.simplex.im,rb2pbttocvnbrngnwziclp2f4ckjq65kebafws6g4hy22cdaiv5dwjqd.onion",
@@ -195,12 +196,15 @@ _defaultSMPServers =
         "smp://N_McQS3F9TGoh4ER0QstUf55kGnNSd-wXfNPZ7HukcM=@smp19.simplex.im,i53bbtoqhlc365k6kxzwdp5w3cdt433s7bwh3y32rcbml2vztiyyz5id.onion"
       ]
       <> map
-        (presetServerCfg False)
+        (presetServerCfg False allRoles operatorSimpleXChat)
         [ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im,o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion",
           "smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion",
           "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
         ]
 
+operatorSimpleXChat :: Maybe OperatorId
+operatorSimpleXChat = Just 1
+
 _defaultNtfServers :: [NtfServer]
 _defaultNtfServers =
   [ "ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,5ex3mupcazy3zlky64ab27phjhijpemsiby33qzq3pliejipbtx5xgad.onion"
@@ -1484,8 +1488,11 @@ processChatCommand' vr = \case
     pure $ CRConnNtfMessages ntfMsgs
   APIGetUserProtoServers userId (AProtocolType p) -> withUserId userId $ \user -> withServerProtocol p $ do
     cfg@ChatConfig {defaultServers} <- asks config
-    servers <- withFastStore' (`getProtocolServers` user)
+    srvs <- withFastStore' (`getProtocolServers` user)
-    pure $ CRUserProtoServers user $ AUPS $ UserProtoServers p (useServers cfg p servers) (cfgServers p defaultServers)
+    ts <- liftIO getCurrentTime
+    operators <- withFastStore' $ \db -> getServerOperators db ts
+    let servers = AUPS $ UserProtoServers p (useServers cfg p srvs) (cfgServers p defaultServers)
+    pure $ CRUserProtoServers {user, servers, operators}
   GetUserProtoServers aProtocol -> withUser $ \User {userId} ->
     processChatCommand $ APIGetUserProtoServers userId aProtocol
   APISetUserProtoServers userId (APSC p (ProtoServersConfig servers))
@@ -1501,6 +1508,37 @@ processChatCommand' vr = \case
     lift $ CRServerTestResult user srv <$> withAgent' (\a -> testProtocolServer a (aUserId user) server)
   TestProtoServer srv -> withUser $ \User {userId} ->
     processChatCommand $ APITestProtoServer userId srv
+  APIGetServerOperators -> pure $ chatCmdError Nothing "not supported"
+  APISetServerOperators _operators -> pure $ chatCmdError Nothing "not supported"
+  APIGetUserServers userId -> withUserId userId $ \user ->
+    pure $ chatCmdError (Just user) "not supported"
+  APISetUserServers userId _userServers -> withUserId userId $ \user ->
+    pure $ chatCmdError (Just user) "not supported"
+  APIValidateServers _userServers ->
+    -- response is CRUserServersValidation
+    pure $ chatCmdError Nothing "not supported"
+  APIGetUsageConditions -> do
+    -- TODO
+    -- get current conditions
+    -- get latest accepted conditions (from operators)
+    ts <- liftIO getCurrentTime
+    let usageConditions =
+          UsageConditions
+            { conditionsId = 1,
+              conditionsCommit = "abc",
+              notifiedAt = Nothing,
+              createdAt = ts
+            }
+    pure
+      CRUsageConditions
+        { usageConditions = usageConditions,
+          conditionsText = usageConditionsText,
+          acceptedConditions = Nothing
+        }
+  APISetConditionsNotified _conditionsId -> do
+    pure $ chatCmdError Nothing "not supported"
+  APIAcceptConditions _conditionsId _opIds ->
+    pure $ chatCmdError Nothing "not supported"
   APISetChatItemTTL userId newTTL_ -> withUserId userId $ \user ->
     checkStoreNotChanged $
       withChatLock "setChatItemTTL" $ do

src/Simplex/Chat/Controller.hs

@@ -57,6 +57,7 @@ import Simplex.Chat.Call
 import Simplex.Chat.Markdown (MarkdownList)
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
+import Simplex.Chat.Operators
 import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.AppVersion
 import Simplex.Chat.Remote.Types
@@ -70,7 +71,7 @@ import Simplex.Chat.Util (liftIOEither)
 import Simplex.FileTransfer.Description (FileDescriptionURI)
 import Simplex.Messaging.Agent (AgentClient, SubscriptionsInfo)
 import Simplex.Messaging.Agent.Client (AgentLocks, AgentQueuesInfo (..), AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure, SMPServerSubs, ServerQueueInfo, UserNetworkInfo)
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig, ServerCfg)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig, OperatorId, ServerCfg)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, UpMigration, withTransaction, withTransactionPriority)
@@ -352,6 +353,14 @@ data ChatCommand
   | SetUserProtoServers AProtoServersConfig
   | APITestProtoServer UserId AProtoServerWithAuth
   | TestProtoServer AProtoServerWithAuth
+  | APIGetServerOperators
+  | APISetServerOperators (NonEmpty (OperatorId, Bool))
+  | APIGetUserServers UserId
+  | APISetUserServers UserId (NonEmpty UserServers)
+  | APIValidateServers (NonEmpty UserServers) -- response is CRUserServersValidation
+  | APIGetUsageConditions
+  | APISetConditionsNotified Int64
+  | APIAcceptConditions Int64 (NonEmpty OperatorId)
   | APISetChatItemTTL UserId (Maybe Int64)
   | SetChatItemTTL (Maybe Int64)
   | APIGetChatItemTTL UserId
@@ -577,8 +586,12 @@ data ChatResponse
   | CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo}
   | CRChatItemId User (Maybe ChatItemId)
   | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
-  | CRUserProtoServers {user :: User, servers :: AUserProtoServers}
+  | CRUserProtoServers {user :: User, servers :: AUserProtoServers, operators :: [ServerOperator]}
   | CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure}
+  | CRServerOperators {operators :: [ServerOperator], conditionsAction :: UsageConditionsAction}
+  | CRUserServers {userServers :: [UserServers]}
+  | CRUserServersValidation {serverErrors :: [UserServersError]}
+  | CRUsageConditions {usageConditions :: UsageConditions, conditionsText :: Text, acceptedConditions :: Maybe UsageConditions}
   | CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
   | CRNetworkConfig {networkConfig :: NetworkConfig}
   | CRContactInfo {user :: User, contact :: Contact, connectionStats_ :: Maybe ConnectionStats, customUserProfile :: Maybe Profile}
@@ -948,6 +961,12 @@ data AProtoServersConfig = forall p. ProtocolTypeI p => APSC (SProtocolType p) (
 
 deriving instance Show AProtoServersConfig
 
+data UserServersError
+  = USEStorageMissing
+  | USEProxyMissing
+  | USEDuplicate {server :: AProtoServerWithAuth}
+  deriving (Show)
+
 data UserProtoServers p = UserProtoServers
   { serverProtocol :: SProtocolType p,
     protoServers :: NonEmpty (ServerCfg p),
@@ -1526,6 +1545,8 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "DB") ''DatabaseError)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "Chat") ''ChatError)
 
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "USE") ''UserServersError)
+
 $(JQ.deriveJSON defaultJSON ''AppFilePathsConfig)
 
 $(JQ.deriveJSON defaultJSON ''ContactSubStatus)

src/Simplex/Chat/Migrations/M20241027_server_operators.hs

@@ -0,0 +1,70 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20241027_server_operators where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20241027_server_operators :: Query
+m20241027_server_operators =
+  [sql|
+CREATE TABLE server_operators (
+  server_operator_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  server_operator_tag TEXT,
+  trade_name TEXT NOT NULL,
+  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,
+  accepted_conditions_commit TEXT,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now'))
+);
+
+ALTER TABLE protocol_servers ADD COLUMN server_operator_id INTEGER REFERENCES server_operators ON DELETE SET NULL;
+
+CREATE TABLE usage_conditions (
+  usage_conditions_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  conditions_commit TEXT NOT NULL UNIQUE,
+  notified_at TEXT,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now'))
+);
+
+CREATE TABLE operator_usage_conditions (
+  operator_usage_conditions_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  server_operator_id INTEGER REFERENCES server_operators (server_operator_id) ON DELETE SET NULL ON UPDATE CASCADE,
+  server_operator_tag TEXT,
+  conditions_commit TEXT NOT NULL,
+  accepted_at TEXT,
+  created_at TEXT NOT NULL DEFAULT (datetime('now'))
+);
+
+CREATE INDEX idx_protocol_servers_server_operator_id ON protocol_servers(server_operator_id);
+CREATE INDEX idx_operator_usage_conditions_server_operator_id ON operator_usage_conditions(server_operator_id);
+CREATE UNIQUE INDEX idx_operator_usage_conditions_conditions_commit ON operator_usage_conditions(server_operator_id, conditions_commit);
+
+INSERT INTO server_operators
+  (server_operator_id, server_operator_tag, trade_name, legal_name, server_domains, enabled)
+  VALUES (1, 'simplex', 'SimpleX Chat', 'SimpleX Chat Ltd', 'simplex.im', 1);
+INSERT INTO server_operators
+  (server_operator_id, server_operator_tag, trade_name, legal_name, server_domains, enabled)
+  VALUES (2, 'xyz', 'XYZ', 'XYZ Ltd', 'xyz.com', 0);
+
+-- UPDATE protocol_servers SET server_operator_id = 1 WHERE host LIKE "%.simplex.im" OR host LIKE "%.simplex.im,%";
+|]
+
+down_m20241027_server_operators :: Query
+down_m20241027_server_operators =
+  [sql|
+DROP INDEX idx_operator_usage_conditions_conditions_commit;
+DROP INDEX idx_operator_usage_conditions_server_operator_id;
+DROP INDEX idx_protocol_servers_server_operator_id;
+
+ALTER TABLE protocol_servers DROP COLUMN server_operator_id;
+
+DROP TABLE operator_usage_conditions;
+DROP TABLE usage_conditions;
+DROP TABLE server_operators;
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -450,6 +450,7 @@ 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',
+  server_operator_id INTEGER REFERENCES server_operators ON DELETE SET NULL,
   UNIQUE(user_id, host, port)
 );
 CREATE TABLE xftp_file_descriptions(
@@ -589,6 +590,34 @@ CREATE TABLE note_folders(
   unread_chat INTEGER NOT NULL DEFAULT 0
 );
 CREATE TABLE app_settings(app_settings TEXT NOT NULL);
+CREATE TABLE server_operators(
+  server_operator_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  server_operator_tag TEXT,
+  trade_name TEXT NOT NULL,
+  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,
+  accepted_conditions_commit TEXT,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE usage_conditions(
+  usage_conditions_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  conditions_commit TEXT NOT NULL UNIQUE,
+  notified_at TEXT,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+CREATE TABLE operator_usage_conditions(
+  operator_usage_conditions_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  server_operator_id INTEGER REFERENCES server_operators(server_operator_id) ON DELETE SET NULL ON UPDATE CASCADE,
+  server_operator_tag TEXT,
+  conditions_commit TEXT NOT NULL,
+  accepted_at TEXT,
+  created_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
 CREATE INDEX contact_profiles_index ON contact_profiles(
   display_name,
   full_name
@@ -890,3 +919,13 @@ CREATE INDEX idx_received_probes_group_member_id on received_probes(
   group_member_id
 );
 CREATE INDEX idx_contact_requests_contact_id ON contact_requests(contact_id);
+CREATE INDEX idx_protocol_servers_server_operator_id ON protocol_servers(
+  server_operator_id
+);
+CREATE INDEX idx_operator_usage_conditions_server_operator_id ON operator_usage_conditions(
+  server_operator_id
+);
+CREATE UNIQUE INDEX idx_operator_usage_conditions_conditions_commit ON operator_usage_conditions(
+  server_operator_id,
+  conditions_commit
+);

src/Simplex/Chat/Operators.hs

@@ -0,0 +1,110 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Chat.Operators where
+
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as J
+import qualified Data.Aeson.Encoding as JE
+import qualified Data.Aeson.TH as JQ
+import Data.FileEmbed
+import Data.Int (Int64)
+import Data.List.NonEmpty (NonEmpty)
+import Data.Text (Text)
+import Data.Time.Clock (UTCTime)
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
+import Language.Haskell.TH.Syntax (lift)
+import Simplex.Chat.Operators.Conditions
+import Simplex.Chat.Types.Util (textParseJSON)
+import Simplex.Messaging.Agent.Env.SQLite (OperatorId, ServerRoles)
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, sumTypeJSON)
+import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolType (..))
+import Simplex.Messaging.Util (safeDecodeUtf8)
+
+usageConditionsCommit :: Text
+usageConditionsCommit = "165143a1112308c035ac00ed669b96b60599aa1c"
+
+usageConditionsText :: Text
+usageConditionsText =
+  $( let s = $(embedFile =<< makeRelativeToProject "PRIVACY.md")
+      in [|stripFrontMatter (safeDecodeUtf8 $(lift s))|]
+   )
+
+data OperatorTag = OTSimplex | OTXyz
+  deriving (Show)
+
+instance FromField OperatorTag where fromField = fromTextField_ textDecode
+
+instance ToField OperatorTag where toField = toField . textEncode
+
+instance FromJSON OperatorTag where
+  parseJSON = textParseJSON "OperatorTag"
+
+instance ToJSON OperatorTag where
+  toJSON = J.String . textEncode
+  toEncoding = JE.text . textEncode
+
+instance TextEncoding OperatorTag where
+  textDecode = \case
+    "simplex" -> Just OTSimplex
+    "xyz" -> Just OTXyz
+    _ -> Nothing
+  textEncode = \case
+    OTSimplex -> "simplex"
+    OTXyz -> "xyz"
+
+data UsageConditions = UsageConditions
+  { conditionsId :: Int64,
+    conditionsCommit :: Text,
+    notifiedAt :: Maybe UTCTime,
+    createdAt :: UTCTime
+  }
+  deriving (Show)
+
+data UsageConditionsAction
+  = UCAReview {operators :: [ServerOperator], deadline :: Maybe UTCTime, showNotice :: Bool}
+  | UCAAccepted {operators :: [ServerOperator]}
+  deriving (Show)
+
+-- TODO UI logic
+usageConditionsAction :: UsageConditionsAction
+usageConditionsAction = UCAAccepted []
+
+data ConditionsAcceptance
+  = CAAccepted {acceptedAt :: UTCTime}
+  | CARequired {deadline :: Maybe UTCTime}
+  deriving (Show)
+
+data ServerOperator = ServerOperator
+  { operatorId :: OperatorId,
+    operatorTag :: Maybe OperatorTag,
+    tradeName :: Text,
+    legalName :: Maybe Text,
+    serverDomains :: [Text],
+    acceptedConditions :: ConditionsAcceptance,
+    enabled :: Bool,
+    roles :: ServerRoles
+  }
+  deriving (Show)
+
+data UserServers = UserServers
+  { operator :: ServerOperator,
+    smpServers :: NonEmpty (ProtoServerWithAuth 'PSMP),
+    xftpServers :: NonEmpty (ProtoServerWithAuth 'PXFTP)
+  }
+  deriving (Show)
+
+$(JQ.deriveJSON defaultJSON ''UsageConditions)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CA") ''ConditionsAcceptance)
+
+$(JQ.deriveJSON defaultJSON ''ServerOperator)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "UCA") ''UsageConditionsAction)
+
+$(JQ.deriveJSON defaultJSON ''UserServers)

src/Simplex/Chat/Operators/Conditions.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Chat.Operators.Conditions where
+
+import Data.Char (isSpace)
+import Data.Text (Text)
+import qualified Data.Text as T
+
+stripFrontMatter :: Text -> Text
+stripFrontMatter =
+  T.unlines
+    . dropWhile ("# " `T.isPrefixOf`) -- strip title
+    . dropWhile (T.all isSpace)
+    . dropWhile fm
+    . (\ls -> let ls' = dropWhile (not . fm) ls in if null ls' then ls else ls')
+    . dropWhile fm
+    . T.lines
+  where
+    fm = ("---" `T.isPrefixOf`)

src/Simplex/Chat/Store/Migrations.hs

@@ -114,6 +114,7 @@ import Simplex.Chat.Migrations.M20240827_calls_uuid
 import Simplex.Chat.Migrations.M20240920_user_order
 import Simplex.Chat.Migrations.M20241008_indexes
 import Simplex.Chat.Migrations.M20241010_contact_requests_contact_id
+import Simplex.Chat.Migrations.M20241027_server_operators
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -227,7 +228,8 @@ schemaMigrations =
     ("20240827_calls_uuid", m20240827_calls_uuid, Just down_m20240827_calls_uuid),
     ("20240920_user_order", m20240920_user_order, Just down_m20240920_user_order),
     ("20241008_indexes", m20241008_indexes, Just down_m20241008_indexes),
-    ("20241010_contact_requests_contact_id", m20241010_contact_requests_contact_id, Just down_m20241010_contact_requests_contact_id)
+    ("20241010_contact_requests_contact_id", m20241010_contact_requests_contact_id, Just down_m20241010_contact_requests_contact_id),
+    ("20241027_server_operators", m20241027_server_operators, Just down_m20241027_server_operators)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Chat/Store/Profiles.hs

@@ -47,7 +47,9 @@ module Simplex.Chat.Store.Profiles
     getContactWithoutConnViaAddress,
     updateUserAddressAutoAccept,
     getProtocolServers,
+    -- overwriteOperatorsAndServers,
     overwriteProtocolServers,
+    getServerOperators,
     createCall,
     deleteCalls,
     getCalls,
@@ -76,6 +78,7 @@ import Database.SQLite.Simple (NamedParam (..), Only (..), (:.) (..))
 import Database.SQLite.Simple.QQ (sql)
 import Simplex.Chat.Call
 import Simplex.Chat.Messages
+import Simplex.Chat.Operators
 import Simplex.Chat.Protocol
 import Simplex.Chat.Store.Direct
 import Simplex.Chat.Store.Shared
@@ -83,7 +86,7 @@ import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.UITheme
-import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..))
+import Simplex.Messaging.Agent.Env.SQLite (OperatorId, ServerCfg (..), ServerRoles (..))
 import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, UserId)
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
@@ -521,20 +524,25 @@ getProtocolServers db User {userId} =
     <$> DB.query
       db
       [sql|
-        SELECT host, port, key_hash, basic_auth, preset, tested, enabled
+        SELECT s.host, s.port, s.key_hash, s.basic_auth, s.server_operator_id, s.preset, s.tested, s.enabled, o.role_storage, o.role_proxy
-        FROM protocol_servers
+        FROM protocol_servers s
-        WHERE user_id = ? AND protocol = ?;
+        LEFT JOIN server_operators o USING (server_operator_id)
+        WHERE s.user_id = ? AND s.protocol = ?
       |]
       (userId, decodeLatin1 $ strEncode protocol)
   where
     protocol = protocolTypeI @p
-    toServerCfg :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Bool) -> ServerCfg p
+    toServerCfg :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Maybe OperatorId, Bool, Maybe Bool, Bool, Maybe Bool, Maybe Bool) -> ServerCfg p
-    toServerCfg (host, port, keyHash, auth_, preset, tested, enabled) =
+    toServerCfg (host, port, keyHash, auth_, operator, preset, tested, enabled, storage_, proxy_) =
       let server = ProtoServerWithAuth (ProtocolServer protocol host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
-       in ServerCfg {server, preset, tested, enabled}
+          roles = ServerRoles {storage = fromMaybe True storage_, proxy = fromMaybe True proxy_}
+       in ServerCfg {server, operator, preset, tested, enabled, roles}
 
-overwriteProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> [ServerCfg p] -> ExceptT StoreError IO ()
+-- overwriteOperatorsAndServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> Maybe [ServerOperator] -> [ServerCfg p] -> ExceptT StoreError IO [ServerCfg p]
+-- overwriteOperatorsAndServers db user@User {userId} operators_ servers = do
+overwriteProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> [ServerCfg p] -> ExceptT StoreError IO ()  
 overwriteProtocolServers db User {userId} servers =
+  -- liftIO $ mapM_ (updateServerOperators_ db) operators_
   checkConstraint SEUniqueID . ExceptT $ do
     currentTs <- getCurrentTime
     DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND protocol = ? " (userId, protocol)
@@ -549,9 +557,62 @@ overwriteProtocolServers db User {userId} servers =
         |]
         ((protocol, host, port, keyHash, safeDecodeUtf8 . unBasicAuth <$> auth_) :. (preset, tested, enabled, userId, currentTs, currentTs))
     pure $ Right ()
+    -- Right <$> getProtocolServers db user
   where
     protocol = decodeLatin1 $ strEncode $ protocolTypeI @p
 
+getServerOperators :: DB.Connection -> UTCTime -> IO [ServerOperator]
+getServerOperators db ts =
+  map toOperator
+    <$> DB.query_
+      db
+      [sql|
+        SELECT server_operator_id, server_operator_tag, trade_name, legal_name, server_domains, enabled, role_storage, role_proxy
+        FROM server_operators;
+      |]
+  where
+    -- TODO get conditions state
+    toOperator (operatorId, operatorTag, tradeName, legalName, domains, enabled, storage, proxy) =
+      let roles = ServerRoles {storage, proxy}
+       in ServerOperator {operatorId, operatorTag, tradeName, legalName, serverDomains = [domains], acceptedConditions = CAAccepted ts, enabled, roles}
+
+-- updateServerOperators_ :: DB.Connection -> [ServerOperator] -> IO [ServerOperator]
+-- updateServerOperators_ db operators = do
+--   DB.execute_ db "DELETE FROM server_operators WHERE preset = 0"
+--   let (existing, new) = partition (isJust . operatorId) operators
+--   existing' <- mapM (\op -> upsertExisting op $> op) existing
+--   new' <- mapM insertNew new
+--   pure $ existing' <> new'
+--   where
+--     upsertExisting ServerOperator {operatorId, name, preset, enabled, roles = ServerRoles {storage, proxy}}
+--       | preset =
+--           DB.execute
+--             db
+--             [sql|
+--               UPDATE server_operators
+--               SET enabled = ?, role_storage = ?, role_proxy = ?
+--               WHERE server_operator_id = ?
+--             |]
+--             (enabled, storage, proxy, operatorId)
+--       | otherwise =
+--           DB.execute
+--             db
+--             [sql|
+--               INSERT INTO server_operators (server_operator_id, name, preset, enabled, role_storage, role_proxy)
+--               VALUES (?,?,?,?,?,?)
+--             |]
+--             (operatorId, name, preset, enabled, storage, proxy)
+--     insertNew op@ServerOperator {name, preset, enabled, roles = ServerRoles {storage, proxy}} = do
+--       DB.execute
+--         db
+--         [sql|
+--           INSERT INTO server_operators (name, preset, enabled, role_storage, role_proxy)
+--           VALUES (?,?,?,?,?)
+--         |]
+--         (name, preset, enabled, storage, proxy)
+--       opId <- insertedRowId db
+--       pure op {operatorId = Just opId}
+
 createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()
 createCall db user@User {userId} Call {contactId, callId, callUUID, chatItemId, callState} callTs = do
   currentTs <- getCurrentTime

src/Simplex/Chat/Terminal.hs

@@ -13,7 +13,7 @@ import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Database.SQLite.Simple (SQLError (..))
 import qualified Database.SQLite.Simple as DB
-import Simplex.Chat (defaultChatConfig)
+import Simplex.Chat (defaultChatConfig, operatorSimpleXChat)
 import Simplex.Chat.Controller
 import Simplex.Chat.Core
 import Simplex.Chat.Help (chatWelcome)
@@ -21,7 +21,7 @@ import Simplex.Chat.Options
 import Simplex.Chat.Terminal.Input
 import Simplex.Chat.Terminal.Output
 import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
-import Simplex.Messaging.Agent.Env.SQLite (presetServerCfg)
+import Simplex.Messaging.Agent.Env.SQLite (allRoles, presetServerCfg)
 import Simplex.Messaging.Client (NetworkConfig (..), SMPProxyFallback (..), SMPProxyMode (..), defaultNetworkConfig)
 import Simplex.Messaging.Util (raceAny_)
 import System.IO (hFlush, hSetEcho, stdin, stdout)
@@ -34,14 +34,14 @@ terminalChatConfig =
           { smp =
               L.fromList $
                 map
-                  (presetServerCfg True)
+                  (presetServerCfg True allRoles operatorSimpleXChat)
                   [ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im,o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion",
                     "smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion",
                     "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
                   ],
             useSMP = 3,
             ntf = ["ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,ntg7jdjy2i3qbib3sykiho3enekwiaqg3icctliqhtqcg6jmoh6cxiad.onion"],
-            xftp = L.map (presetServerCfg True) defaultXFTPServers,
+            xftp = L.map (presetServerCfg True allRoles operatorSimpleXChat) defaultXFTPServers,
             useXFTP = L.length defaultXFTPServers,
             netCfg =
               defaultNetworkConfig

src/Simplex/Chat/View.hs

@@ -19,7 +19,7 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (isSpace, toUpper)
 import Data.Function (on)
 import Data.Int (Int64)
-import Data.List (groupBy, intercalate, intersperse, partition, sortOn)
+import Data.List (foldl', groupBy, intercalate, intersperse, partition, sortOn)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
@@ -42,6 +42,7 @@ import Simplex.Chat.Help
 import Simplex.Chat.Markdown
 import Simplex.Chat.Messages hiding (NewChatItem (..))
 import Simplex.Chat.Messages.CIContent
+import Simplex.Chat.Operators
 import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.AppVersion (AppVersion (..), pattern AppVersionRange)
 import Simplex.Chat.Remote.Types
@@ -95,8 +96,12 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRChats chats -> viewChats ts tz chats
   CRApiChat u chat -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat]
   CRApiParsedMarkdown ft -> [viewJSON ft]
-  CRUserProtoServers u userServers -> ttyUser u $ viewUserServers userServers testView
+  CRUserProtoServers u userServers operators  -> ttyUser u $ viewUserServers userServers operators testView
   CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure
+  CRServerOperators {} -> []
+  CRUserServers {} -> []
+  CRUserServersValidation _ -> []
+  CRUsageConditions {} -> []
   CRChatItemTTL u ttl -> ttyUser u $ viewChatItemTTL ttl
   CRNetworkConfig cfg -> viewNetworkConfig cfg
   CRContactInfo u ct cStats customUserProfile -> ttyUser u $ viewContactInfo ct cStats customUserProfile
@@ -1209,8 +1214,8 @@ viewUserPrivacy User {userId} User {userId = userId', localDisplayName = n', sho
     "profile is " <> if isJust viewPwdHash then "hidden" else "visible"
   ]
 
-viewUserServers :: AUserProtoServers -> Bool -> [StyledString]
+viewUserServers :: AUserProtoServers -> [ServerOperator] -> Bool -> [StyledString]
-viewUserServers (AUPS UserProtoServers {serverProtocol = p, protoServers, presetServers}) testView =
+viewUserServers (AUPS UserProtoServers {serverProtocol = p, protoServers, presetServers}) operators testView =
   customServers
     <> if testView
       then []
@@ -1228,8 +1233,8 @@ viewUserServers (AUPS UserProtoServers {serverProtocol = p, protoServers, preset
     pName = protocolName p
     customServers =
       if null protoServers
-        then ("no " <> pName <> " servers saved, using presets: ") : viewServers presetServers
+        then ("no " <> pName <> " servers saved, using presets: ") : viewServers operators presetServers
-        else viewServers protoServers
+        else viewServers operators protoServers
 
 protocolName :: ProtocolTypeI p => SProtocolType p -> StyledString
 protocolName = plain . map toUpper . T.unpack . decodeLatin1 . strEncode
@@ -1326,8 +1331,11 @@ viewConnectionStats ConnectionStats {rcvQueuesInfo, sndQueuesInfo} =
   ["receiving messages via: " <> viewRcvQueuesInfo rcvQueuesInfo | not $ null rcvQueuesInfo]
     <> ["sending messages via: " <> viewSndQueuesInfo sndQueuesInfo | not $ null sndQueuesInfo]
 
-viewServers :: ProtocolTypeI p => NonEmpty (ServerCfg p) -> [StyledString]
+viewServers :: ProtocolTypeI p => [ServerOperator] -> NonEmpty (ServerCfg p) -> [StyledString]
-viewServers = map (plain . B.unpack . strEncode . (\ServerCfg {server} -> server)) . L.toList
+viewServers operators = map (plain . (\ServerCfg {server, operator} -> B.unpack (strEncode server) <> viewOperator operator)) . L.toList
+  where
+    ops :: Map (Maybe Int64) 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

tests/ChatClient.hs

@@ -423,11 +423,10 @@ smpServerCfg =
   ServerConfig
     { transports = [(serverPort, transport @TLS, False)],
       tbqSize = 1,
-      -- serverTbqSize = 1,
-      msgQueueQuota = 16,
       msgStoreType = AMSType SMSMemory,
-      maxJournalMsgCount = 1000,
+      msgQueueQuota = 16,
-      maxJournalStateLines = 1000,
+      maxJournalMsgCount = 24,
+      maxJournalStateLines = 4,
       queueIdBytes = 12,
       msgIdBytes = 6,
       storeLogFile = Nothing,

tests/RandomServers.hs

@@ -9,7 +9,7 @@ import Control.Monad (replicateM)
 import qualified Data.List.NonEmpty as L
 import Simplex.Chat (cfgServers, cfgServersToUse, defaultChatConfig, randomServers)
 import Simplex.Chat.Controller (ChatConfig (..))
-import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..))
+import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..))
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), SProtocolType (..), UserProtocol)
 import Test.Hspec
 
@@ -18,6 +18,8 @@ randomServersTests = describe "choosig random servers" $ do
   it "should choose 4 random SMP servers and keep the rest disabled" testRandomSMPServers
   it "should keep all 6 XFTP servers" testRandomXFTPServers
 
+deriving instance Eq ServerRoles
+
 deriving instance Eq (ServerCfg p)
 
 testRandomSMPServers :: IO ()