test, fix

tests/Bots/DirectoryTests.hs

@@ -104,7 +104,7 @@ mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup webFolder =
       directoryLog = Just $ ps </> "directory_service.log",
       migrateDirectoryLog = Nothing,
       serviceName = "SimpleX Directory",
-      clientService = False,
+      clientService = True,
       runCLI = False,
       searchResults = 3,
       webFolder,

tests/ChatClient.hs

@@ -25,6 +25,7 @@ import Data.Functor (($>))
 import Data.List (dropWhileEnd, find)
 import Data.Maybe (isNothing)
 import qualified Data.Text as T
+import Data.Time.Clock (getCurrentTime)
 import Network.Socket
 import Simplex.Chat
 import Simplex.Chat.Controller (ChatCommand (..), ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..), defaultSimpleNetCfg)
@@ -282,11 +283,12 @@ prevVersion (Version v) = Version (v - 1)
 nextVersion :: Version v -> Version v
 nextVersion (Version v) = Version (v + 1)
 
-createTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC
-createTestChat ps cfg opts@ChatOpts {coreOptions} dbPrefix profile = do
+createTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> Bool -> Profile -> IO TestCC
+createTestChat ps cfg opts@ChatOpts {coreOptions} dbPrefix clientService profile = do
   Right db@ChatDatabase {chatStore, agentStore} <- createDatabase ps coreOptions dbPrefix
   insertUser agentStore
-  Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile True
+  ts <- getCurrentTime
+  Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecordAt db' (AgentUserId 1) clientService profile True ts
   startTestChat_ ps db cfg opts user
 
 startTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> IO TestCC
@@ -352,6 +354,9 @@ stopTestChat ps TestCC {chatController = cc@ChatController {smpAgent, chatStore}
 withNewTestChat :: HasCallStack => TestParams -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
 withNewTestChat ps = withNewTestChatCfgOpts ps testCfg testOpts
 
+withNewTestChat_ :: HasCallStack => TestParams -> String -> Bool -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
+withNewTestChat_ ps = withNewTestChatCfgOpts_ ps testCfg testOpts
+
 withNewTestChatV1 :: HasCallStack => TestParams -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
 withNewTestChatV1 ps = withNewTestChatCfg ps testCfgV1
 
@@ -362,9 +367,12 @@ withNewTestChatOpts :: HasCallStack => TestParams -> ChatOpts -> String -> Profi
 withNewTestChatOpts ps = withNewTestChatCfgOpts ps testCfg
 
 withNewTestChatCfgOpts :: HasCallStack => TestParams -> ChatConfig -> ChatOpts -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
-withNewTestChatCfgOpts ps cfg opts dbPrefix profile runTest =
+withNewTestChatCfgOpts ps cfg opts dbPrefix = withNewTestChatCfgOpts_ ps cfg opts dbPrefix False
+
+withNewTestChatCfgOpts_ :: HasCallStack => TestParams -> ChatConfig -> ChatOpts -> String -> Bool -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
+withNewTestChatCfgOpts_ ps cfg opts dbPrefix clientService profile runTest =
   bracket
-    (createTestChat ps cfg opts dbPrefix profile)
+    (createTestChat ps cfg opts dbPrefix clientService profile)
     (stopTestChat ps)
     (\cc -> runTest cc >>= ((cc <// 100000) $>))
 
@@ -423,7 +431,7 @@ testChatN cfg opts ps test params =
   where
     getTestCCs :: [(Profile, Int)] -> IO [TestCC]
     getTestCCs [] = pure []
-    getTestCCs ((p, db) : envs') = (:) <$> createTestChat params cfg opts (show db) p <*> getTestCCs envs'
+    getTestCCs ((p, db) : envs') = (:) <$> createTestChat params cfg opts (show db) False p <*> getTestCCs envs'
     endTests tcs = do
       mapConcurrently_ (<// 100000) tcs
       mapConcurrently_ (stopTestChat params) tcs

tests/ChatTests/Profiles.hs

@@ -112,6 +112,9 @@ chatProfileTests = do
     it "should connect via contact address" testShortLinkContactAddress
     it "should join group" testShortLinkJoinGroup
   describe "short links with attached data" shortLinkTests
+  describe "client services" $ do
+    it "should create user as a service, disable and re-enable" testClientService
+    it "should create user without a service, enable and disable" testSwitchClientService
 
 shortLinkTests :: SpecWith TestParams
 shortLinkTests = do
@@ -4187,3 +4190,81 @@ testShortLinkGroupChangeProfileReceived = testChat3 aliceProfile bobProfile cath
       [alice, cath] *<# "#club bob> 2"
       cath #> "#club 3"
       [alice, bob] *<# "#club cath> 3"
+
+testClientService :: HasCallStack => TestParams -> IO ()
+testClientService ps =
+  withNewTestChat ps "alice" aliceProfile $ \alice ->
+    withNewTestChat ps "bob" bobProfile $ \bob -> do
+      -- create user as service
+      withNewTestChat_ ps "service" True serviceProfile $ \service -> do
+        connectUsers alice service
+        alice <##> service
+        service ##> "/set client service 1:service_user off"
+        service <## "error: chat not stopped"
+      -- connect as service
+      withTestChat ps "service" $ \service -> do
+        subscribeClientService service 1
+        alice <##> service
+      setClientService ps "off"
+      -- connect without service
+      withTestChat ps "service" $ \service -> do
+        service <## "subscribed 1 connections on server localhost"
+        alice <##> service
+        connectUsers bob service
+        bob <##> service
+      setClientService ps "on"
+      -- connect as service, queue associated
+      withTestChat ps "service" $ \service -> do
+        service <## "subscribed 2 connections on server localhost"
+        alice <##> service
+        bob <##> service
+      -- connect as service
+      withTestChat ps "service" $ \service -> do
+        subscribeClientService service 2
+        alice <##> service
+        bob <##> service
+
+testSwitchClientService :: HasCallStack => TestParams -> IO ()
+testSwitchClientService ps =
+  withNewTestChat ps "user" aliceProfile $ \alice ->
+    withNewTestChat ps "bob" bobProfile $ \bob -> do
+      -- create user without service
+      withNewTestChat_ ps "service" False serviceProfile $ \service -> do
+        connectUsers alice service
+        alice <##> service
+      -- connect without service
+      withTestChat ps "service" $ \service -> do
+        service <## "subscribed 1 connections on server localhost"
+        alice <##> service
+      setClientService ps "on"
+      -- connect as service, queue associated
+      withTestChat ps "service" $ \service -> do
+        service <## "subscribed 1 connections on server localhost"
+        alice <##> service
+        connectUsers bob service
+        bob <##> service
+      -- connect as service
+      withTestChat ps "service" $ \service -> do
+        subscribeClientService service 2
+        alice <##> service
+        bob <##> service
+      -- connect without service
+      setClientService ps "off"
+      withTestChat ps "service" $ \service -> do
+        service <## "subscribed 2 connections on server localhost"
+        alice <##> service
+        bob <##> service
+
+setClientService :: TestParams -> String -> IO ()
+setClientService ps onOff =
+  withTestChatCfgOpts ps testCfg testOpts {maintenance = True} "service" $ \service -> do
+    service ##> ("/set client service 1:service_user " <> onOff)
+    service <## "ok"
+    
+subscribeClientService :: TestCC -> Int -> IO ()
+subscribeClientService service n =
+  service
+    <###
+      [ ConsoleString $ "subscribed service (" <> show n <> " connections) on server localhost: ok",
+        "received messages from service on server localhost"
+      ]

tests/ChatTests/Utils.hs

@@ -78,6 +78,9 @@ eveProfile = mkProfile "eve" "Eve" Nothing
 businessProfile :: Profile
 businessProfile = mkProfile "biz" "Biz Inc" Nothing
 
+serviceProfile :: Profile
+serviceProfile = mkProfile "service_user" "Service user" Nothing
+
 mkProfile :: T.Text -> T.Text -> Maybe ImageData -> Profile
 mkProfile displayName descr image = Profile {displayName, fullName = "", shortDescr = Just descr, image, contactLink = Nothing, peerType = Nothing, preferences = defaultPrefs}
 

tests/MobileTests.hs

@@ -22,6 +22,7 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BS
 import Data.ByteString.Internal (create)
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Time.Clock (getCurrentTime)
 import Data.Word (Word8, Word32)
 import Foreign.C
 import Foreign.Marshal.Alloc (mallocBytes)
@@ -147,7 +148,8 @@ testChatApi ps = do
       dbPrefix = tmp </> "1"
   Right ChatDatabase {chatStore, agentStore} <- createChatDatabase (ChatDbOpts dbPrefix "myKey" DB.TQOff True) (MigrationConfig MCYesUp Nothing)
   insertUser agentStore
-  Right _ <- withTransaction chatStore $ \db -> runExceptT $ createUserRecord db (AgentUserId 1) aliceProfile {preferences = Nothing} True
+  ts <- getCurrentTime
+  Right _ <- withTransaction chatStore $ \db -> runExceptT $ createUserRecordAt db (AgentUserId 1) False aliceProfile {preferences = Nothing} True ts
   Right cc <- chatMigrateInit dbPrefix "myKey" "yesUp"
   Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "" "yesUp"
   Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "anotherKey" "yesUp"