diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 0b6491b1e9..fab6b762f7 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -432,16 +432,18 @@ processChatCommand vr nm = \case UnhideUser viewPwd -> withUser $ \User {userId} -> processChatCommand vr nm $ APIUnhideUser userId viewPwd MuteUser -> withUser $ \User {userId} -> processChatCommand vr nm $ APIMuteUser userId UnmuteUser -> withUser $ \User {userId} -> processChatCommand vr nm $ APIUnmuteUser userId - SetClientService userId' name enable -> checkChatStopped $ withUser $ \currUser@User {userId} -> do - user@User {clientService, profile = LocalProfile {displayName}} <- + SetClientService userId' name enable -> checkChatStopped $ withUser' $ \currUser@User {userId} -> do + user@User {agentUserId = AgentUserId auId, clientService, profile = LocalProfile {displayName}} <- if userId == userId' then pure currUser else privateGetUser userId' unless (name == displayName) $ throwChatError CEUserUnknown if enable == isTrue clientService then ok user else do withStore' $ \db -> updateClientService db userId' enable - let user' = user' {clientService = BoolDef enable} :: User + withAgent $ \a -> setUserService a auId enable + let user' = user {clientService = BoolDef enable} :: User when (userId == userId') $ chatWriteVar currentUser $ Just user' + setStoreChanged ok user' APIDeleteUser userId' delSMPQueues viewPwd_ -> withUser $ \user -> do user' <- privateGetUser userId' @@ -4325,7 +4327,7 @@ chatCommandP = "/unhide user " *> (UnhideUser <$> pwdP), "/mute user" $> MuteUser, "/unmute user" $> UnmuteUser, - "/set client service " *> (SetClientService <$> A.decimal <* A.char ':' <*> displayNameP <*> onOffP), + "/set client service " *> (SetClientService <$> A.decimal <* A.char ':' <*> displayNameP <* A.space <*> onOffP), "/_delete user " *> (APIDeleteUser <$> A.decimal <* " del_smp=" <*> onOffP <*> optional (A.space *> jsonP)), "/delete user " *> (DeleteUser <$> displayNameP <*> pure True <*> optional (A.space *> pwdP)), ("/user" <|> "/u") $> ShowActiveUser, diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index bc541b9abe..40218dbdb6 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -20,7 +20,6 @@ module Simplex.Chat.Store.Profiles UserMsgReceiptSettings (..), UserContactLink (..), GroupLinkInfo (..), - createUserRecord, createUserRecordAt, getUsersInfo, getUsers, @@ -126,9 +125,6 @@ import Database.SQLite.Simple (Only (..), Query, (:.) (..)) import Database.SQLite.Simple.QQ (sql) #endif -createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User -createUserRecord db auId p activeUser = createUserRecordAt db auId False p activeUser =<< liftIO getCurrentTime - createUserRecordAt :: DB.Connection -> AgentUserId -> Bool -> Profile -> Bool -> UTCTime -> ExceptT StoreError IO User createUserRecordAt db (AgentUserId auId) clientService Profile {displayName, fullName, shortDescr, image, peerType, preferences = userPreferences} activeUser currentTs = checkConstraint SEDuplicateName . liftIO $ do diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index e00b015299..48177c4ea4 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -455,7 +455,7 @@ chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView} let Connection {connId} = entityConnection acEntity in ttyUser u [sShow connId <> ": END"] CEvtSubscriptionStatus srv status conns -> [plain $ subStatusStr status <> " " <> tshow (length conns) <> " connections on server " <> showSMPServer srv] - CEvtServiceSubStatus srv event -> viewServiceSubEvent srv event + CEvtServiceSubStatus srv event -> [plain $ serviceSubEventStr srv event] CEvtReceivedGroupInvitation {user = u, groupInfo = g, contact = c, memberRole = r} -> ttyUser u $ viewReceivedGroupInvitation g c r CEvtUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g CEvtJoinedGroupMember u g m -> ttyUser u $ viewJoinedGroupMember g m @@ -1472,15 +1472,15 @@ subStatusStr = \case SSRemoved e -> "removed: " <> T.pack e SSNoSub -> "no subscription" -viewServiceSubEvent :: SMPServer -> ServiceSubEvent -> [StyledString] -viewServiceSubEvent srv event = [plain $ eventStr <> " on server " <> showSMPServer srv] +serviceSubEventStr :: SMPServer -> ServiceSubEvent -> Text +serviceSubEventStr srv = \case + ServiceSubUp e_ n -> "subscribed service " <> conns n <> srvStr <> ": " <> fromMaybe "ok" e_ + ServiceSubDown n -> "disconnected service " <> conns n <> srvStr + ServiceSubAll -> "received messages from service" <> srvStr -- "(" <> n <> "connections)" + ServiceSubEnd n -> "service subscription ended " <> conns n <> srvStr where - eventStr = case event of - ServiceSubUp e_ n -> "subscribed service " <> conns n <> ": " <> fromMaybe "ok" e_ - ServiceSubDown n -> "disconnected service " <> conns n - ServiceSubAll -> "received messages from service" -- "(" <> n <> "connections)" - ServiceSubEnd n -> "service subscription ended " <> conns n - conns n = "(" <> tshow n <> "connections)" + conns n = "(" <> tshow n <> " connections)" + srvStr = " on server " <> showSMPServer srv viewUserServers :: UserOperatorServers -> [StyledString] viewUserServers (UserOperatorServers _ [] []) = [] diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 03cc5aaf48..40d82e5eed 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/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, diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 36e6b7a0a8..adcc3955af 100644 --- a/tests/ChatClient.hs +++ b/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 )) @@ -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_ ( 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" + ] diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 87be15afe5..9db93fa7a6 100644 --- a/tests/ChatTests/Utils.hs +++ b/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} diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index 7213a0e91c..e9be3839c9 100644 --- a/tests/MobileTests.hs +++ b/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"