From 1fbf21d3953bea03ff05d827fe46dca05845bc90 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Fri, 15 Nov 2024 07:15:04 +0000 Subject: [PATCH] core: validate servers of all user profiles (#5180) * core: validate servers of all user profiles * validate all servers * fix parsing, test --- simplex-chat.cabal | 1 + src/Simplex/Chat.hs | 12 ++- src/Simplex/Chat/Controller.hs | 4 +- src/Simplex/Chat/Operators.hs | 130 ++++++++++++++++++++++++--------- src/Simplex/Chat/View.hs | 2 +- tests/OperatorTests.hs | 92 +++++++++++++++++++++++ tests/RandomServers.hs | 4 +- tests/Test.hs | 2 + 8 files changed, 207 insertions(+), 40 deletions(-) create mode 100644 tests/OperatorTests.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index d3ea814011..8d1a298af4 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -618,6 +618,7 @@ test-suite simplex-chat-test MarkdownTests MessageBatching MobileTests + OperatorTests ProtocolTests RandomServers RemoteTests diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 86b6a5e51b..05f99656bb 100644 --- a/src/Simplex/Chat.hs +++ b/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), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 3c2b8045d7..27acf8990b 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/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} diff --git a/src/Simplex/Chat/Operators.hs b/src/Simplex/Chat/Operators.hs index 55de357090..6bf1a75da4 100644 --- a/src/Simplex/Chat/Operators.hs +++ b/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) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 2f289afe4b..317fd58a8e 100644 --- a/src/Simplex/Chat/View.hs +++ b/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 diff --git a/tests/OperatorTests.hs b/tests/OperatorTests.hs new file mode 100644 index 0000000000..1b867a3e1d --- /dev/null +++ b/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} diff --git a/tests/RandomServers.hs b/tests/RandomServers.hs index 8b0b94dbd5..048a2b5e5a 100644 --- a/tests/RandomServers.hs +++ b/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 diff --git a/tests/Test.hs b/tests/Test.hs index 3d59b840dd..079c583a6e 100644 --- a/tests/Test.hs +++ b/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