diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 32251338f..ff98129e1 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -79,7 +79,8 @@ defaultChatConfig = dbPoolSize = 1, yesToMigrations = False, tbqSize = 16, - fileChunkSize = 15780 + fileChunkSize = 15780, + testView = False } logCfg :: LogConfig diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 516ff68a2..feeedeaf7 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -49,7 +49,8 @@ data ChatConfig = ChatConfig dbPoolSize :: Int, yesToMigrations :: Bool, tbqSize :: Natural, - fileChunkSize :: Integer + fileChunkSize :: Integer, + testView :: Bool } data ActiveTo = ActiveNone | ActiveC ContactName | ActiveG GroupName diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 1904d5565..1d1c94a1f 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -70,7 +70,7 @@ chatInit dbFilePrefix = do let f = chatStoreFile dbFilePrefix chatStore <- createStore f (dbPoolSize defaultMobileConfig) (yesToMigrations defaultMobileConfig) user_ <- getActiveUser_ chatStore - newChatController chatStore user_ defaultMobileConfig mobileChatOpts {dbFilePrefix} . const $ pure () + newChatController chatStore user_ defaultMobileConfig mobileChatOpts {dbFilePrefix} (const $ pure ()) chatSendCmd :: ChatController -> String -> IO JSONString chatSendCmd cc s = LB.unpack . J.encode . APIResponse Nothing <$> runReaderT (execChatCommand $ B.pack s) cc diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index bc094ab4e..2d625d7eb 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -2050,13 +2050,13 @@ getDirectChatPreviews_ db User {userId} = do JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id JOIN connections c ON c.contact_id = ct.contact_id LEFT JOIN ( - SELECT contact_id, MAX(item_ts) AS MaxDate + SELECT contact_id, MAX(chat_item_id) AS MaxId FROM chat_items WHERE item_deleted != 1 GROUP BY contact_id - ) CIMaxDates ON CIMaxDates.contact_id = ct.contact_id - LEFT JOIN chat_items ci ON ci.contact_id = CIMaxDates.contact_id - AND ci.item_ts = CIMaxDates.MaxDate + ) MaxIds ON MaxIds.contact_id = ct.contact_id + LEFT JOIN chat_items ci ON ci.contact_id = MaxIds.contact_id + AND ci.chat_item_id = MaxIds.MaxId LEFT JOIN ( SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread FROM chat_items @@ -2113,13 +2113,13 @@ getGroupChatPreviews_ db User {userId, userContactId} = do JOIN group_members mu ON mu.group_id = g.group_id JOIN contact_profiles pu ON pu.contact_profile_id = mu.contact_profile_id LEFT JOIN ( - SELECT group_id, MAX(item_ts) AS MaxDate + SELECT group_id, MAX(chat_item_id) AS MaxId FROM chat_items WHERE item_deleted != 1 GROUP BY group_id - ) GIMaxDates ON GIMaxDates.group_id = g.group_id - LEFT JOIN chat_items ci ON ci.group_id = GIMaxDates.group_id - AND ci.item_ts = GIMaxDates.MaxDate + ) MaxIds ON MaxIds.group_id = g.group_id + LEFT JOIN chat_items ci ON ci.group_id = MaxIds.group_id + AND ci.chat_item_id = MaxIds.MaxId LEFT JOIN ( SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread FROM chat_items diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index f4bc51769..e401b4b8c 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -29,7 +29,8 @@ runInputLoop :: ChatTerminal -> ChatController -> IO () runInputLoop ct cc = forever $ do s <- atomically . readTBQueue $ inputQ cc r <- runReaderT (execChatCommand . encodeUtf8 $ T.pack s) cc - printToTerminal ct $ responseToView s r + let testV = testView $ config cc + printToTerminal ct $ responseToView s testV r runTerminalInput :: ChatTerminal -> ChatController -> IO () runTerminalInput ct cc = withChatTerm ct $ do diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index 7de744f56..79526e624 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -73,9 +73,10 @@ withTermLock ChatTerminal {termLock} action = do atomically $ putTMVar termLock () runTerminalOutput :: ChatTerminal -> ChatController -> IO () -runTerminalOutput ct cc = +runTerminalOutput ct cc = do + let testV = testView $ config cc forever $ - atomically (readTBQueue $ outputQ cc) >>= printToTerminal ct . responseToView "" . snd + atomically (readTBQueue $ outputQ cc) >>= printToTerminal ct . responseToView "" testV . snd printToTerminal :: ChatTerminal -> [StyledString] -> IO () printToTerminal ct s = diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 0f0a0476d..4b95f0757 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -19,7 +19,7 @@ import Numeric (showFFloat) import Simplex.Chat.Controller import Simplex.Chat.Help import Simplex.Chat.Markdown -import Simplex.Chat.Messages +import Simplex.Chat.Messages hiding (NewChatItem (..)) import Simplex.Chat.Protocol import Simplex.Chat.Store (StoreError (..)) import Simplex.Chat.Styled @@ -30,14 +30,14 @@ import qualified Simplex.Messaging.Protocol as SMP import System.Console.ANSI.Types serializeChatResponse :: ChatResponse -> String -serializeChatResponse = unlines . map unStyle . responseToView "" +serializeChatResponse = unlines . map unStyle . responseToView "" False -responseToView :: String -> ChatResponse -> [StyledString] -responseToView cmd = \case +responseToView :: String -> Bool -> ChatResponse -> [StyledString] +responseToView cmd testView = \case CRActiveUser User {profile} -> r $ viewUserProfile profile CRChatStarted -> r ["chat started"] - CRApiChats chats -> r [sShow chats] - CRApiChat chat -> r [sShow chat] + CRApiChats chats -> r $ if testView then testViewChats chats else [sShow chats] + CRApiChat chat -> r $ if testView then testViewChat chat else [sShow chat] CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item CRChatItemUpdated _ -> [] CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr @@ -124,6 +124,21 @@ responseToView cmd = \case -- this function should be `r` for "synchronous", `id` for "asynchronous" command responses -- r' = id r' = r + testViewChats :: [AChat] -> [StyledString] + testViewChats chats = [sShow $ map toChatView chats] + where + toChatView :: AChat -> (Text, Text) + toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName}) items _)) = ("@" <> localDisplayName, toCIPreview items) + toChatView (AChat _ (Chat (GroupChat GroupInfo {localDisplayName}) items _)) = ("#" <> localDisplayName, toCIPreview items) + toChatView (AChat _ (Chat (ContactRequest UserContactRequest {localDisplayName}) items _)) = ("<@" <> localDisplayName, toCIPreview items) + toCIPreview :: [CChatItem c] -> Text + toCIPreview ((CChatItem _ ChatItem {meta}) : _) = itemText meta + toCIPreview _ = "" + testViewChat :: AChat -> [StyledString] + testViewChat (AChat _ Chat {chatItems}) = [sShow $ map toChatView chatItems] + where + toChatView :: CChatItem c -> (Int, Text) + toChatView (CChatItem dir ChatItem {meta}) = (msgDirectionInt $ toMsgDirection dir, itemText meta) viewChatItem :: ChatInfo c -> ChatItem c d -> [StyledString] viewChatItem chat (ChatItem cd meta content) = case (chat, cd) of diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index fa0556560..b16a74dab 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -70,7 +70,8 @@ cfg :: ChatConfig cfg = defaultChatConfig { agentConfig = - aCfg {reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000}} + aCfg {reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000}}, + testView = True } virtualSimplexChat :: FilePath -> Profile -> IO TestCC @@ -79,7 +80,7 @@ virtualSimplexChat dbFilePrefix profile = do Right user <- runExceptT $ createUser st profile True t <- withVirtualTerminal termSettings pure ct <- newChatTerminal t - cc <- newChatController st (Just user) cfg opts {dbFilePrefix} . const $ pure () -- no notifications + cc <- newChatController st (Just user) cfg opts {dbFilePrefix} (const $ pure ()) -- no notifications chatAsync <- async $ runSimplexChat user ct cc termQ <- newTQueueIO termAsync <- async $ readTerminalOutput t termQ diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 82916e5ff..d08f99b98 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -12,7 +12,7 @@ import qualified Data.ByteString as B import Data.Char (isDigit) import Data.Maybe (fromJust) import qualified Data.Text as T -import Simplex.Chat.Controller +import Simplex.Chat.Controller (ChatController (..)) import Simplex.Chat.Types (Profile (..), User (..)) import Simplex.Chat.Util (unlessM) import System.Directory (doesFileExist) @@ -66,10 +66,31 @@ testAddContact = concurrently_ (bob <## "alice (Alice): contact is connected") (alice <## "bob (Bob): contact is connected") + -- empty chats + alice #$$> ("/_get chats", [("@bob", "")]) + alice #$> ("/_get chat @2 count=100", chat, []) + bob #$$> ("/_get chats", [("@alice", "")]) + bob #$> ("/_get chat @2 count=100", chat, []) + -- one message alice #> "@bob hello 🙂" bob <# "alice> hello 🙂" + alice #$$> ("/_get chats", [("@bob", "hello 🙂")]) + alice #$> ("/_get chat @2 count=100", chat, [(1, "hello 🙂")]) + bob #$$> ("/_get chats", [("@alice", "hello 🙂")]) + bob #$> ("/_get chat @2 count=100", chat, [(0, "hello 🙂")]) + -- many messages bob #> "@alice hi" alice <# "bob> hi" + alice #$$> ("/_get chats", [("@bob", "hi")]) + alice #$> ("/_get chat @2 count=100", chat, [(1, "hello 🙂"), (0, "hi")]) + bob #$$> ("/_get chats", [("@alice", "hi")]) + bob #$> ("/_get chat @2 count=100", chat, [(0, "hello 🙂"), (1, "hi")]) + -- pagination + alice #$> ("/_get chat @2 after=1 count=100", chat, [(0, "hi")]) + alice #$> ("/_get chat @2 before=2 count=100", chat, [(1, "hello 🙂")]) + -- read messages + alice #$> ("/_read chat @2 from=1 to=100", id, "ok") + bob #$> ("/_read chat @2 from=1 to=100", id, "ok") -- test adding the same contact one more time - local name will be different alice ##> "/c" inv' <- getInvitation alice @@ -82,11 +103,15 @@ testAddContact = bob <# "alice_1> hello" bob #> "@alice_1 hi" alice <# "bob_1> hi" + alice #$$> ("/_get chats", [("@bob_1", "hi"), ("@bob", "hi")]) + bob #$$> ("/_get chats", [("@alice_1", "hi"), ("@alice", "hi")]) -- test deleting contact alice ##> "/d bob_1" alice <## "bob_1: contact is deleted" alice ##> "@bob_1 hey" alice <## "no contact bob_1" + alice #$$> ("/_get chats", [("@bob", "hi")]) + bob #$$> ("/_get chats", [("@alice_1", "hi"), ("@alice", "hi")]) testGroup :: IO () testGroup = @@ -133,11 +158,23 @@ testGroup = concurrently_ (alice <# "#team bob> hi there") (cath <# "#team bob> hi there") - cath #> "#team hey" + cath #> "#team hey team" concurrently_ - (alice <# "#team cath> hey") - (bob <# "#team cath> hey") + (alice <# "#team cath> hey team") + (bob <# "#team cath> hey team") bob <##> cath + -- get and read chats + alice #$$> ("/_get chats", [("#team", "hey team"), ("@cath", ""), ("@bob", "")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, "hello"), (0, "hi there"), (0, "hey team")]) + alice #$> ("/_get chat #1 after=1 count=100", chat, [(0, "hi there"), (0, "hey team")]) + alice #$> ("/_get chat #1 before=3 count=100", chat, [(1, "hello"), (0, "hi there")]) + bob #$$> ("/_get chats", [("@cath", "hey"), ("#team", "hey team"), ("@alice", "")]) + bob #$> ("/_get chat #1 count=100", chat, [(0, "hello"), (1, "hi there"), (0, "hey team")]) + cath #$$> ("/_get chats", [("@bob", "hey"), ("#team", "hey team"), ("@alice", "")]) + cath #$> ("/_get chat #1 count=100", chat, [(0, "hello"), (0, "hi there"), (1, "hey team")]) + alice #$> ("/_read chat #1 from=1 to=100", id, "ok") + bob #$> ("/_read chat #1 from=1 to=100", id, "ok") + cath #$> ("/_read chat #1 from=1 to=100", id, "ok") -- list groups alice ##> "/gs" alice <## "#team" @@ -661,20 +698,24 @@ testUserContactLink = testChat3 aliceProfile bobProfile cathProfile $ cLink <- getContactLink alice True bob ##> ("/c " <> cLink) alice <#? bob + alice #$$> ("/_get chats", [("<@bob", "")]) alice ##> "/ac bob" alice <## "bob: accepting contact request..." concurrently_ (bob <## "alice (Alice): contact is connected") (alice <## "bob (Bob): contact is connected") + alice #$$> ("/_get chats", [("@bob", "")]) alice <##> bob cath ##> ("/c " <> cLink) alice <#? cath + alice #$$> ("/_get chats", [("<@cath", ""), ("@bob", "hey")]) alice ##> "/ac cath" alice <## "cath: accepting contact request..." concurrently_ (cath <## "alice (Alice): contact is connected") (alice <## "cath (Catherine): contact is connected") + alice #$$> ("/_get chats", [("@cath", ""), ("@bob", "hey")]) alice <##> cath testRejectContactAndDeleteUserContact :: IO () @@ -824,6 +865,21 @@ cc #> cmd = do cc `send` cmd cc <# cmd +(#$>) :: (Eq a, Show a) => TestCC -> (String, String -> a, a) -> Expectation +cc #$> (cmd, f, res) = do + cc ##> cmd + (f <$> getTermLine cc) `shouldReturn` res + +chat :: String -> [(Int, String)] +chat = read + +(#$$>) :: TestCC -> (String, [(String, String)]) -> Expectation +cc #$$> (cmd, res) = do + cc ##> cmd + line <- getTermLine cc + let chats = read line + chats `shouldMatchList` res + send :: TestCC -> String -> IO () send TestCC {chatController = cc} cmd = atomically $ writeTBQueue (inputQ cc) cmd