diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index ecf125599..085f6b093 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -59,13 +59,15 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do rh' = if either (const False) allowRemoteCommand cmd then rh else Nothing unless (isMessage cmd) $ echo s r <- runReaderT (execChatCommand rh' bs) cc - processResp s cmd r + processResp s cmd rh r printRespToTerminal ct cc False rh r startLiveMessage cmd r where echo s = printToTerminal ct [plain s] - processResp s cmd = \case - CRActiveUser _ -> setActive ct "" + processResp s cmd rh = \case + CRActiveUser u -> case rh of + Nothing -> setActive ct "" + Just rhId -> updateRemoteUser ct u rhId CRChatItems u chatName_ _ -> whenCurrUser cc u $ mapM_ (setActive ct . chatActiveTo) chatName_ CRNewChatItem u (AChatItem _ SMDSnd cInfo _) -> whenCurrUser cc u $ setActiveChat ct cInfo CRChatItemUpdated u (AChatItem _ SMDSnd cInfo _) -> whenCurrUser cc u $ setActiveChat ct cInfo diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index 98d4285a2..0adb4999a 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -10,6 +10,7 @@ module Simplex.Chat.Terminal.Output where import Control.Concurrent (ThreadId) +import Control.Logger.Simple import Control.Monad import Control.Monad.Catch (MonadMask) import Control.Monad.Except @@ -19,21 +20,23 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (getCurrentTime) import Data.Time.LocalTime (getCurrentTimeZone) -import Simplex.Chat (processChatCommand) +import Simplex.Chat (execChatCommand, processChatCommand) import Simplex.Chat.Controller import Simplex.Chat.Markdown import Simplex.Chat.Messages import Simplex.Chat.Messages.CIContent (CIContent(..), SMsgDirection (..)) import Simplex.Chat.Options import Simplex.Chat.Protocol (MsgContent (..), msgContentText) -import Simplex.Chat.Remote.Types (RemoteHostId) +import Simplex.Chat.Remote.Types (RHKey (..), RemoteHostId, RemoteHostInfo (..), RemoteHostSession (..)) import Simplex.Chat.Styled import Simplex.Chat.Terminal.Notification (Notification (..), initializeNotifications) import Simplex.Chat.Types import Simplex.Chat.View import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Util (safeDecodeUtf8) +import Simplex.Messaging.TMap (TMap) +import qualified Simplex.Messaging.TMap as TM +import Simplex.Messaging.Util (safeDecodeUtf8, tshow) import System.Console.ANSI.Types import System.IO (IOMode (..), hPutStrLn, withFile) import System.Mem.Weak (Weak) @@ -49,7 +52,8 @@ data ChatTerminal = ChatTerminal nextMessageRow :: TVar Int, termLock :: TMVar (), sendNotification :: Maybe (Notification -> IO ()), - activeTo :: TVar String + activeTo :: TVar String, + currentRemoteUsers :: TMap RemoteHostId User } data TerminalState = TerminalState @@ -104,6 +108,7 @@ newChatTerminal t opts = do nextMessageRow <- newTVarIO lastRow sendNotification <- if muteNotifications opts then pure Nothing else Just <$> initializeNotifications activeTo <- newTVarIO "" + currentRemoteUsers <- newTVarIO mempty -- threadDelay 500000 -- this delay is the same as timeout in getTerminalSize pure ChatTerminal @@ -114,7 +119,8 @@ newChatTerminal t opts = do nextMessageRow, termLock, sendNotification, - activeTo + activeTo, + currentRemoteUsers } mkTermState :: TerminalState @@ -143,12 +149,14 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = d case r of CRNewChatItem u ci -> markChatItemRead u ci CRChatItemUpdated u ci -> markChatItemRead u ci + CRRemoteHostConnected {remoteHost = RemoteHostInfo {remoteHostId}} -> getRemoteUser remoteHostId + CRRemoteHostStopped {remoteHostId_} -> mapM_ removeRemoteUser remoteHostId_ _ -> pure () let printResp = case logFilePath of Just path -> if logResponseToFile r then logResponse path else printToTerminal ct _ -> printToTerminal ct liveItems <- readTVarIO showLiveItems - responseString cc liveItems outputRH r >>= printResp + responseString ct cc liveItems outputRH r >>= printResp responseNotification ct cc r where markChatItemRead u (AChatItem _ _ chat ci@ChatItem {chatDir, meta = CIMeta {itemStatus}}) = @@ -159,6 +167,10 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = d void $ runReaderT (runExceptT $ processChatCommand (APIChatRead chatRef (Just (itemId, itemId)))) cc _ -> pure () logResponse path s = withFile path AppendMode $ \h -> mapM_ (hPutStrLn h . unStyle) s + getRemoteUser rhId = runReaderT (execChatCommand (Just rhId) "/user") cc >>= \case + CRActiveUser {user} -> updateRemoteUser ct user rhId + cr -> logError $ "Unexpected reply while getting remote user: " <> tshow cr + removeRemoteUser rhId = atomically $ TM.delete rhId (currentRemoteUsers ct) responseNotification :: ChatTerminal -> ChatController -> ChatResponse -> IO () responseNotification t@ChatTerminal {sendNotification} cc = \case @@ -255,15 +267,29 @@ whenCurrUser cc u a = do sameUser User {userId = uId} = maybe False $ \User {userId} -> userId == uId printRespToTerminal :: ChatTerminal -> ChatController -> Bool -> Maybe RemoteHostId -> ChatResponse -> IO () -printRespToTerminal ct cc liveItems outputRH r = responseString cc liveItems outputRH r >>= printToTerminal ct +printRespToTerminal ct cc liveItems outputRH r = responseString ct cc liveItems outputRH r >>= printToTerminal ct -responseString :: ChatController -> Bool -> Maybe RemoteHostId -> ChatResponse -> IO [StyledString] -responseString cc liveItems outputRH r = do - currentRH <- readTVarIO $ currentRemoteHost cc - user <- readTVarIO $ currentUser cc -- XXX: local user, should be subsumed by remote when connected +responseString :: ChatTerminal -> ChatController -> Bool -> Maybe RemoteHostId -> ChatResponse -> IO [StyledString] +responseString ct cc liveItems outputRH r = do + cu <- getCurrentUser ct cc ts <- getCurrentTime tz <- getCurrentTimeZone - pure $ responseToView (currentRH, user) (config cc) liveItems ts tz outputRH r + pure $ responseToView cu (config cc) liveItems ts tz outputRH r + +updateRemoteUser :: ChatTerminal -> User -> RemoteHostId -> IO () +updateRemoteUser ct user rhId = atomically $ TM.insert rhId user (currentRemoteUsers ct) + +getCurrentUser :: ChatTerminal -> ChatController -> IO (Maybe RemoteHostId, Maybe User) +getCurrentUser ct cc = atomically $ do + localUser_ <- readTVar (currentUser cc) + readTVar (currentRemoteHost cc) >>= \case + Nothing -> pure (Nothing, localUser_) + Just rhId -> + TM.lookup (RHId rhId) (remoteHostSessions cc) >>= \case + Just (_, RHSessionConnected {}) -> do + hostUser_ <- TM.lookup rhId (currentRemoteUsers ct) + pure (Just rhId, hostUser_) + _ -> pure (Nothing, localUser_) printToTerminal :: ChatTerminal -> [StyledString] -> IO () printToTerminal ct s = diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs index 147f1d939..ea6413834 100644 --- a/tests/RemoteTests.hs +++ b/tests/RemoteTests.hs @@ -44,6 +44,7 @@ remoteTests = describe "Remote" $ do it "should send files from CLI without /store" remoteCLIFileTest it "switches remote hosts" switchRemoteHostTest it "indicates remote hosts" indicateRemoteHostTest + it "works with multiple profiles" multipleProfilesTest -- * Chat commands @@ -416,6 +417,55 @@ indicateRemoteHostTest = testChat4 aliceProfile aliceDesktopProfile bobProfile c desktop <##> cath cath <##> desktop +multipleProfilesTest :: FilePath -> IO () +multipleProfilesTest = testChat4 aliceProfile aliceDesktopProfile bobProfile cathProfile $ \mobile desktop bob cath -> do + connectUsers desktop cath + + desktop ##> "/create user desk_bottom" + desktop <## "user profile: desk_bottom" + desktop <## "use /p to change it" + desktop <## "(the updated profile will be sent to all your contacts)" + desktop ##> "/users" + desktop <## "alice_desktop (Alice Desktop)" + desktop <## "desk_bottom (active)" + + startRemote mobile desktop + contactBob desktop bob + desktop ##> "/users" + desktop <## "alice (Alice) (active)" + + desktop ##> "/create user alt_alice" + desktop <## "user profile: alt_alice" + desktop <## "use /p to change it" + desktop <## "(the updated profile will be sent to all your contacts)" + + desktop ##> "/users" + desktop <## "alice (Alice)" + desktop <## "alt_alice (active)" + + desktop ##> "/user" + desktop <## "user profile: alt_alice" + desktop <## "use /p to change it" + desktop <## "(the updated profile will be sent to all your contacts)" + + bob #> "@alice hi" + (desktop, "[user: alice] ") ^<# "bob> hi" + + cath #> "@alice_desktop hello" + (desktop, "[local, user: alice_desktop] ") ^<# "cath> hello" + + desktop ##> "/switch remote host local" + desktop <## "Using local profile" + desktop ##> "/user" + desktop <## "user profile: desk_bottom" + desktop <## "use /p to change it" + desktop <## "(the updated profile will be sent to all your contacts)" + + bob #> "@alice hey" + (desktop, "[remote: 1, user: alice] ") ^<# "bob> hey" + + stopDesktop mobile desktop + -- * Utils startRemote :: TestCC -> TestCC -> IO ()