test chat items (#285)

2026-05-14 19:05:27 +00:00 · 2022-02-09 20:58:02 +04:00
parent 7af4cdffee
commit ff7a8cade1
9 changed files with 102 additions and 26 deletions
@@ -79,7 +79,8 @@ defaultChatConfig =
      dbPoolSize = 1,
      yesToMigrations = False,
      tbqSize = 16,
-      fileChunkSize = 15780
+      fileChunkSize = 15780,
+      testView = False
    }

 logCfg :: LogConfig
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 =
@@ -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
@@ -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
@@ -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