core: validate servers of all user profiles (#5180)

* core: validate servers of all user profiles

* validate all servers

* fix parsing, test

simplex-chat.cabal

@@ -618,6 +618,7 @@ test-suite simplex-chat-test
       MarkdownTests
       MessageBatching
       MobileTests
+      OperatorTests
       ProtocolTests
       RandomServers
       RemoteTests

src/Simplex/Chat.hs

@@ -1608,7 +1608,7 @@ processChatCommand' vr = \case
   APIGetUserServers userId -> withUserId userId $ \user -> withFastStore $ \db ->
     CRUserServers user <$> (liftIO . groupByOperator =<< getUserServers db user)
   APISetUserServers userId userServers -> withUserId userId $ \user -> do
-    let errors = validateUserServers userServers
+    errors <- validateAllUsersServers userId $ L.toList userServers
     unless (null errors) $ throwChatError (CECommandError $ "user servers validation error(s): " <> show errors)
     (operators, smpServers, xftpServers) <- withFastStore $ \db -> do
       setUserServers db user userServers
@@ -1620,7 +1620,8 @@ processChatCommand' vr = \case
       setProtocolServers a auId $ agentServerCfgs opDomains (rndServers SPSMP rs) smpServers
       setProtocolServers a auId $ agentServerCfgs opDomains (rndServers SPXFTP rs) xftpServers
     ok_
-  APIValidateServers userServers -> pure $ CRUserServersValidation $ validateUserServers userServers
+  APIValidateServers userId userServers -> withUserId userId $ \user ->
+    CRUserServersValidation user <$> validateAllUsersServers userId userServers
   APIGetUsageConditions -> do
     (usageConditions, acceptedConditions) <- withFastStore $ \db -> do
       usageConditions <- getCurrentUsageConditions db
@@ -2926,6 +2927,11 @@ processChatCommand' vr = \case
     withServerProtocol p action = case userProtocol p of
       Just Dict -> action
       _ -> throwChatError $ CEServerProtocol $ AProtocolType p
+    validateAllUsersServers :: UserServersClass u => Int64 -> [u] -> CM [UserServersError]
+    validateAllUsersServers currUserId userServers = withFastStore $ \db -> do
+      users' <- filter (\User {userId} -> userId /= currUserId) <$> liftIO (getUsers db)
+      others <- mapM (\user -> liftIO . fmap (user,) . groupByOperator =<< getUserServers db user) users'
+      pure $ validateUserServers userServers others
     forwardFile :: ChatName -> FileTransferId -> (ChatName -> CryptoFile -> ChatCommand) -> CM ChatResponse
     forwardFile chatName fileId sendCommand = withUser $ \user -> do
       withStore (\db -> getFileTransfer db user fileId) >>= \case
@@ -8242,7 +8248,7 @@ chatCommandP =
       "/_operators " *> (APISetServerOperators <$> jsonP),
       "/_servers " *> (APIGetUserServers <$> A.decimal),
       "/_servers " *> (APISetUserServers <$> A.decimal <* A.space <*> jsonP),
-      "/_validate_servers " *> (APIValidateServers <$> jsonP),
+      "/_validate_servers " *> (APIValidateServers <$> A.decimal <* A.space <*> jsonP),
       "/_conditions" $> APIGetUsageConditions,
       "/_conditions_notified " *> (APISetConditionsNotified <$> A.decimal),
       "/_accept_conditions " *> (APIAcceptConditions <$> A.decimal <*> _strP),

src/Simplex/Chat/Controller.hs

@@ -358,7 +358,7 @@ data ChatCommand
   | APISetServerOperators (NonEmpty ServerOperator)
   | APIGetUserServers UserId
   | APISetUserServers UserId (NonEmpty UpdatedUserOperatorServers)
-  | APIValidateServers (NonEmpty UpdatedUserOperatorServers) -- response is CRUserServersValidation
+  | APIValidateServers UserId [ValidatedUserOperatorServers] -- response is CRUserServersValidation
   | APIGetUsageConditions
   | APISetConditionsNotified Int64
   | APIAcceptConditions Int64 (NonEmpty Int64)
@@ -590,7 +590,7 @@ data ChatResponse
   | CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure}
   | CRServerOperators {operators :: [ServerOperator], conditionsAction :: Maybe UsageConditionsAction}
   | CRUserServers {user :: User, userServers :: [UserOperatorServers]}
-  | CRUserServersValidation {serverErrors :: [UserServersError]}
+  | CRUserServersValidation {user :: User, serverErrors :: [UserServersError]}
   | CRUsageConditions {usageConditions :: UsageConditions, conditionsText :: Text, acceptedConditions :: Maybe UsageConditions}
   | CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
   | CRNetworkConfig {networkConfig :: NetworkConfig}

src/Simplex/Chat/Operators.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
@@ -13,6 +14,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Chat.Operators where
@@ -22,10 +24,12 @@ 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.Either (partitionEithers)
 import Data.FileEmbed
 import Data.Foldable (foldMap')
 import Data.IORef
 import Data.Int (Int64)
+import Data.Kind
 import Data.List (find, foldl')
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
@@ -43,11 +47,12 @@ 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 (User)
 import Simplex.Chat.Types.Util (textParseJSON)
 import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, sumTypeJSON)
-import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI, SProtocolType (..), UserProtocol)
+import Simplex.Messaging.Protocol (AProtocolType (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI, SProtocolType (..), UserProtocol)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util (atomicModifyIORef'_, safeDecodeUtf8)
 
@@ -196,10 +201,56 @@ data UpdatedUserOperatorServers = UpdatedUserOperatorServers
   }
   deriving (Show)
 
-updatedServers :: UserProtocol p => UpdatedUserOperatorServers -> SProtocolType p -> [AUserServer p]
-updatedServers UpdatedUserOperatorServers {smpServers, xftpServers} = \case
-  SPSMP -> smpServers
-  SPXFTP -> xftpServers
+data ValidatedUserOperatorServers = ValidatedUserOperatorServers
+  { operator :: Maybe ServerOperator,
+    smpServers :: [AValidatedServer 'PSMP],
+    xftpServers :: [AValidatedServer 'PXFTP]
+  }
+  deriving (Show)
+
+data AValidatedServer p = forall s. AVS (SDBStored s) (ValidatedServer s p)
+
+deriving instance Show (AValidatedServer p)
+
+type ValidatedServer s p = UserServer_ s ValidatedProtoServer p
+
+data ValidatedProtoServer p = ValidatedProtoServer {unVPS :: Either Text (ProtoServerWithAuth p)}
+  deriving (Show)
+
+class UserServersClass u where
+  type AServer u = (s :: ProtocolType -> Type) | s -> u
+  operator' :: u -> Maybe ServerOperator
+  partitionValid :: [AServer u p] -> ([Text], [AUserServer p])
+  servers' :: UserProtocol p => u -> SProtocolType p -> [AServer u p]
+
+instance UserServersClass UserOperatorServers where
+  type AServer UserOperatorServers = UserServer_ 'DBStored ProtoServerWithAuth
+  operator' UserOperatorServers {operator} = operator
+  partitionValid ss = ([], map (AUS SDBStored) ss)
+  servers' UserOperatorServers {smpServers, xftpServers} = \case
+    SPSMP -> smpServers
+    SPXFTP -> xftpServers
+
+instance UserServersClass UpdatedUserOperatorServers where
+  type AServer UpdatedUserOperatorServers = AUserServer
+  operator' UpdatedUserOperatorServers {operator} = operator
+  partitionValid = ([],)
+  servers' UpdatedUserOperatorServers {smpServers, xftpServers} = \case
+    SPSMP -> smpServers
+    SPXFTP -> xftpServers
+
+instance UserServersClass ValidatedUserOperatorServers where
+  type AServer ValidatedUserOperatorServers = AValidatedServer
+  operator' ValidatedUserOperatorServers {operator} = operator
+  partitionValid = partitionEithers . map serverOrErr
+    where
+      serverOrErr :: AValidatedServer p -> Either Text (AUserServer p)
+      serverOrErr (AVS s srv@UserServer {server = server'}) = (\server -> AUS s srv {server}) <$> unVPS server'
+  servers' ValidatedUserOperatorServers {smpServers, xftpServers} = \case
+    SPSMP -> smpServers
+    SPXFTP -> xftpServers
+
+type UserServer' s p = UserServer_ s ProtoServerWithAuth p
 
 type UserServer p = UserServer' 'DBStored p
 
@@ -209,9 +260,9 @@ data AUserServer p = forall s. AUS (SDBStored s) (UserServer' s p)
 
 deriving instance Show (AUserServer p)
 
-data UserServer' s p = UserServer
+data UserServer_ s (srv :: ProtocolType -> Type) (p :: ProtocolType) = UserServer
   { serverId :: DBEntityId' s,
-    server :: ProtoServerWithAuth p,
+    server :: srv p,
     preset :: Bool,
     tested :: Maybe Bool,
     enabled :: Bool,
@@ -352,35 +403,36 @@ groupByOperator (ops, smpSrvs, xftpSrvs) = do
     addXFTP srv s@UserOperatorServers {xftpServers} = (s :: UserOperatorServers) {xftpServers = srv : xftpServers}
 
 data UserServersError
-  = USEStorageMissing {protocol :: AProtocolType}
-  | USEProxyMissing {protocol :: AProtocolType}
-  | USEDuplicateServer {protocol :: AProtocolType, duplicateServer :: AProtoServerWithAuth, duplicateHost :: TransportHost}
+  = USENoServers {protocol :: AProtocolType, user :: Maybe User}
+  | USEStorageMissing {protocol :: AProtocolType, user :: Maybe User}
+  | USEProxyMissing {protocol :: AProtocolType, user :: Maybe User}
+  | USEInvalidServer {protocol :: AProtocolType, invalidServer :: Text}
+  | USEDuplicateServer {protocol :: AProtocolType, duplicateServer :: Text, duplicateHost :: TransportHost}
   deriving (Show)
 
-validateUserServers :: NonEmpty UpdatedUserOperatorServers -> [UserServersError]
-validateUserServers uss =
-  missingRolesErr SPSMP storage USEStorageMissing
-    <> missingRolesErr SPSMP proxy USEProxyMissing
-    <> missingRolesErr SPXFTP storage USEStorageMissing
-    <> duplicatServerErrs SPSMP
-    <> duplicatServerErrs SPXFTP
+validateUserServers :: UserServersClass u' => [u'] -> [(User, [UserOperatorServers])] -> [UserServersError]
+validateUserServers curr others = currUserErrs <> concatMap otherUserErrs others
   where
-    missingRolesErr :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> (ServerRoles -> Bool) -> (AProtocolType -> UserServersError) -> [UserServersError]
-    missingRolesErr p roleSel err = [err (AProtocolType p) | not hasRole]
+    currUserErrs = noServersErrs SPSMP Nothing curr <> noServersErrs SPXFTP Nothing curr <> serverErrs SPSMP curr <> serverErrs SPXFTP curr
+    otherUserErrs (user, uss) = noServersErrs SPSMP (Just user) uss <> noServersErrs SPXFTP (Just user) uss
+    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)]
       where
-        hasRole =
-          any (\(AUS _ UserServer {deleted, enabled}) -> enabled && not deleted) $
-            concatMap (`updatedServers` p) $ filter roleEnabled (L.toList uss)
-        roleEnabled UpdatedUserOperatorServers {operator} =
-          maybe True (\ServerOperator {enabled, roles} -> enabled && roleSel roles) operator
-    duplicatServerErrs :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [UserServersError]
-    duplicatServerErrs p = mapMaybe duplicateErr_ srvs
+        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'
+        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
       where
-        srvs =
-          filter (\(AUS _ UserServer {deleted}) -> not deleted) $
-            concatMap (`updatedServers` p) (L.toList uss)
+        p' = AProtocolType p
+        (invalidSrvs, userSrvs) = partitionValid $ concatMap (`servers'` p) uss
+        srvs = filter (\(AUS _ UserServer {deleted}) -> not deleted) userSrvs
         duplicateErr_ (AUS _ srv@UserServer {server}) =
-          USEDuplicateServer (AProtocolType p) (AProtoServerWithAuth p server)
+          USEDuplicateServer p' (safeDecodeUtf8 $ strEncode server)
             <$> find (`S.member` duplicateHosts) (srvHost srv)
         duplicateHosts = snd $ foldl' addHost (S.empty, S.empty) allHosts
         allHosts = concatMap (\(AUS _ srv) -> L.toList $ srvHost srv) srvs
@@ -421,18 +473,30 @@ instance DBStoredI s => FromJSON (ServerOperator' s) where
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "UCA") ''UsageConditionsAction)
 
 instance ProtocolTypeI p => ToJSON (UserServer' s p) where
-  toEncoding = $(JQ.mkToEncoding defaultJSON ''UserServer')
-  toJSON = $(JQ.mkToJSON defaultJSON ''UserServer')
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''UserServer_)
+  toJSON = $(JQ.mkToJSON defaultJSON ''UserServer_)
 
 instance (DBStoredI s, ProtocolTypeI p) => FromJSON (UserServer' s p) where
-  parseJSON = $(JQ.mkParseJSON defaultJSON ''UserServer')
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''UserServer_)
 
 instance ProtocolTypeI p => FromJSON (AUserServer p) where
   parseJSON v = (AUS SDBStored <$> parseJSON v) <|> (AUS SDBNew <$> parseJSON v)
 
+instance ProtocolTypeI p => FromJSON (ValidatedProtoServer p) where
+  parseJSON v = ValidatedProtoServer <$> ((Right <$> parseJSON v) <|> (Left <$> parseJSON v))
+
+instance (DBStoredI s, ProtocolTypeI p) => FromJSON (ValidatedServer s p) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''UserServer_)
+
+instance ProtocolTypeI p => FromJSON (AValidatedServer p) where
+  parseJSON v = (AVS SDBStored <$> parseJSON v) <|> (AVS SDBNew <$> parseJSON v)
+
 $(JQ.deriveJSON defaultJSON ''UserOperatorServers)
 
 instance FromJSON UpdatedUserOperatorServers where
   parseJSON = $(JQ.mkParseJSON defaultJSON ''UpdatedUserOperatorServers)
 
+instance FromJSON ValidatedUserOperatorServers where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''ValidatedUserOperatorServers)
+
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "USE") ''UserServersError)

src/Simplex/Chat/View.hs

@@ -100,7 +100,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure
   CRServerOperators ops ca -> viewServerOperators ops ca 
   CRUserServers u uss -> ttyUser u $ concatMap viewUserServers uss <> (if testView then [] else serversUserHelp)
-  CRUserServersValidation _ -> []
+  CRUserServersValidation {} -> []
   CRUsageConditions {} -> []
   CRChatItemTTL u ttl -> ttyUser u $ viewChatItemTTL ttl
   CRNetworkConfig cfg -> viewNetworkConfig cfg

tests/OperatorTests.hs

@@ -0,0 +1,92 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+
+module OperatorTests (operatorTests) where
+
+import qualified Data.List.NonEmpty as L
+import Simplex.Chat
+import Simplex.Chat.Operators
+import Simplex.Chat.Types
+import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
+import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..), allRoles)
+import Simplex.Messaging.Protocol
+import Test.Hspec
+
+operatorTests :: Spec
+operatorTests = describe "managing server operators" $ do
+  validateServers
+
+validateServers :: Spec
+validateServers = describe "validate user servers" $ do
+  it "should pass valid user servers" $ validateUserServers [valid] [] `shouldBe` []
+  it "should fail without servers" $ do
+    validateUserServers [invalidNoServers] [] `shouldBe` [USENoServers aSMP Nothing]
+    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]
+  it "should fail with duplicate host" $ do
+    validateUserServers [invalidDuplicate] [] `shouldBe`
+      [ USEDuplicateServer aSMP "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion" "smp8.simplex.im",
+        USEDuplicateServer aSMP "smp://abcd@smp8.simplex.im" "smp8.simplex.im"
+      ]
+  it "should fail with invalid host" $ do
+    validateUserServers [invalidHost] [] `shouldBe` [USENoServers aXFTP Nothing, USEInvalidServer aSMP "smp:abcd@smp8.simplex.im"]
+  where
+    aSMP = AProtocolType SPSMP
+    aXFTP = AProtocolType SPXFTP
+
+deriving instance Eq User
+
+deriving instance Eq UserServersError
+
+valid :: UpdatedUserOperatorServers
+valid =
+  UpdatedUserOperatorServers
+    { operator = Just operatorSimpleXChat {operatorId = DBEntityId 1},
+      smpServers = map (AUS SDBNew) simplexChatSMPServers,
+      xftpServers = map (AUS SDBNew . presetServer True) $ L.toList defaultXFTPServers
+    }
+
+invalidNoServers :: UpdatedUserOperatorServers
+invalidNoServers = (valid :: UpdatedUserOperatorServers) {smpServers = []}
+
+invalidDisabled :: UpdatedUserOperatorServers
+invalidDisabled =
+  (valid :: UpdatedUserOperatorServers)
+    { smpServers = map (AUS SDBNew . (\srv -> (srv :: NewUserServer 'PSMP) {enabled = False})) simplexChatSMPServers
+    }
+
+invalidDisabledOp :: UpdatedUserOperatorServers
+invalidDisabledOp =
+  (valid :: UpdatedUserOperatorServers)
+    { operator = Just operatorSimpleXChat {operatorId = DBEntityId 1, enabled = False}
+    }
+
+invalidNoStorage :: UpdatedUserOperatorServers
+invalidNoStorage =
+  (valid :: UpdatedUserOperatorServers)
+    { operator = Just operatorSimpleXChat {operatorId = DBEntityId 1, roles = allRoles {storage = False}}
+    }
+
+invalidDuplicate :: UpdatedUserOperatorServers
+invalidDuplicate =
+  (valid :: UpdatedUserOperatorServers)
+    { smpServers = map (AUS SDBNew) $ simplexChatSMPServers <> [presetServer True "smp://abcd@smp8.simplex.im"]
+    }
+
+invalidHost :: ValidatedUserOperatorServers
+invalidHost =
+  ValidatedUserOperatorServers
+    { operator = Just operatorSimpleXChat {operatorId = DBEntityId 1},
+      smpServers = [validatedServer (Left "smp:abcd@smp8.simplex.im"), validatedServer (Right "smp://abcd@smp8.simplex.im")],
+      xftpServers = []
+    }
+  where
+    validatedServer srv =
+      AVS SDBNew (presetServer @'PSMP True "smp://abcd@smp8.simplex.im") {server = ValidatedProtoServer srv}

tests/RandomServers.hs

@@ -1,8 +1,10 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
@@ -16,7 +18,7 @@ import qualified Data.List.NonEmpty as L
 import Data.Monoid (Sum (..))
 import Simplex.Chat (defaultChatConfig, randomPresetServers)
 import Simplex.Chat.Controller (ChatConfig (..), PresetServers (..))
-import Simplex.Chat.Operators (DBEntityId' (..), NewUserServer, UserServer' (..), operatorServers, operatorServersToUse)
+import Simplex.Chat.Operators
 import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..))
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), SProtocolType (..), UserProtocol)
 import Test.Hspec

tests/Test.hs

@@ -10,6 +10,7 @@ import MarkdownTests
 import MessageBatching
 import MobileTests
 import ProtocolTests
+import OperatorTests
 import RandomServers
 import RemoteTests
 import SchemaDump
@@ -31,6 +32,7 @@ main = do
     around tmpBracket $ describe "WebRTC encryption" webRTCTests
     describe "Valid names" validNameTests
     describe "Message batching" batchingTests
+    describe "Operators" operatorTests
     describe "Random servers" randomServersTests
     around testBracket $ do
       describe "Mobile API Tests" mobileTests