implement

tests/Bots/BroadcastTests.hs

@@ -63,6 +63,7 @@ testBroadcastMessages ps = do
   botLink <-
     withNewTestChat ps botDbPrefix broadcastBotProfile $ \bc_bot ->
       withNewTestChat ps "alice" aliceProfile $ \alice -> do
+        createCCFeed bc_bot
         connectUsers bc_bot alice
         bc_bot ##> "/ad"
         getContactLink bc_bot True
@@ -79,11 +80,14 @@ testBroadcastMessages ps = do
           bob <## "I broadcast messages to all connected users from @alice."
           cath `connectVia` botLink
           alice #> "@broadcast_bot hello all!"
-          alice <# "broadcast_bot> hello all!" -- we broadcast to the sender too, /feed is used by bot
+          -- the bot replies as soon as the feed item is created; the broadcast is delivered by feed jobs
+          alice
+            <### [ WithTime "broadcast_bot> > hello all!",
+                   ConsoleString "      Message is being delivered to all contacts",
+                   WithTime "broadcast_bot> hello all!" -- we broadcast to the sender too, /feed is used by bot
+                 ]
           bob <# "broadcast_bot> hello all!"
           cath <# "broadcast_bot> hello all!"
-          alice <# "broadcast_bot> > hello all!"
-          alice <## "      Forwarded to 3 contact(s), 0 errors"
   where
     cc `connectVia` botLink = do
       cc ##> ("/c " <> botLink)

tests/ChatTests.hs

@@ -4,6 +4,7 @@ import ChatTests.ChatList
 import ChatTests.ChatRelays
 import ChatTests.DBUtils
 import ChatTests.Direct
+import ChatTests.Feed
 import ChatTests.Files
 import ChatTests.Forward
 import ChatTests.Groups
@@ -18,6 +19,7 @@ chatTests = do
   describe "group tests" chatGroupTests
   describe "chat relay tests" chatRelayTests
   describe "local chats tests" chatLocalChatsTests
+  describe "feed tests" chatFeedTests
   describe "file tests" chatFileTests
   describe "profile tests" chatProfileTests
   describe "chat list pagination tests" chatListTests

tests/ChatTests/Direct.hs

@@ -992,8 +992,9 @@ testMultilineMessage = testChat3 aliceProfile bobProfile cathProfile $ \alice bo
   alice <## "there"
   bob <# "alice> hello"
   bob <## "there"
+  createCCFeed alice
   alice `send` "/feed \"hello\\nthere\"" -- /feed "hello\nthere"
-  alice <##. "/feed (2)"
+  alice <# "% hello"
   alice <## "there"
   bob <# "alice> hello"
   bob <## "there"

tests/ChatTests/Feed.hs

@@ -0,0 +1,106 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PostfixOperators #-}
+
+module ChatTests.Feed where
+
+import ChatClient
+import ChatTests.DBUtils
+import ChatTests.Utils
+import Simplex.Chat.Controller (ChatConfig (..))
+import Test.Hspec hiding (it)
+
+chatFeedTests :: SpecWith TestParams
+chatFeedTests = do
+  describe "feed" $ do
+    it "broadcast to contacts and customer groups in several buckets" testFeedBuckets
+    it "edit and delete the broadcast in every chat" testFeedEditDelete
+
+-- one recipient per bucket, so each stream runs three buckets for two recipients
+feedTestCfg :: ChatConfig
+feedTestCfg = testCfg {feedBucketSize = 1}
+
+testFeedBuckets :: HasCallStack => TestParams -> IO ()
+testFeedBuckets =
+  testChatCfg5 feedTestCfg businessProfile aliceProfile bobProfile cathProfile danProfile $
+    \biz alice bob cath dan -> do
+      createCCFeed biz
+      -- two contacts
+      connectUsers biz alice
+      connectUsers biz bob
+      -- two customer groups
+      biz ##> "/ad"
+      cLink <- getContactLink biz True
+      biz ##> "/auto_accept on business"
+      biz <## "auto_accept on, business"
+      connectToBusiness biz cath cLink "cath" "Catherine"
+      connectToBusiness biz dan cLink "dan" "Daniel"
+
+      biz `send` "/feed hello everyone"
+      biz <# "% hello everyone"
+      -- the contacts stream and the customer groups stream deliver concurrently
+      alice <# "biz> hello everyone"
+      bob <# "biz> hello everyone"
+      cath <# "#biz biz_1> hello everyone"
+      dan <# "#biz biz_1> hello everyone"
+
+      -- the broadcast is one item in the feed and the last item of every recipient chat
+      chatItems biz "%1" 10 `shouldReturn` [(1, "hello everyone")]
+      chatItems biz "@2" 1 `shouldReturn` [(1, "hello everyone")]
+      chatItems biz "@3" 1 `shouldReturn` [(1, "hello everyone")]
+      chatItems biz "#1" 1 `shouldReturn` [(1, "hello everyone")]
+      chatItems biz "#2" 1 `shouldReturn` [(1, "hello everyone")]
+
+testFeedEditDelete :: HasCallStack => TestParams -> IO ()
+testFeedEditDelete =
+  testChatCfg4 feedTestCfg businessProfile aliceProfile bobProfile cathProfile $
+    \biz alice bob cath -> do
+      createCCFeed biz
+      connectUsers biz alice
+      connectUsers biz bob
+      biz ##> "/ad"
+      cLink <- getContactLink biz True
+      biz ##> "/auto_accept on business"
+      biz <## "auto_accept on, business"
+      connectToBusiness biz cath cLink "cath" "Catherine"
+
+      biz `send` "/feed hello everyone"
+      biz <# "% hello everyone"
+      alice <# "biz> hello everyone"
+      bob <# "biz> hello everyone"
+      cath <# "#biz biz_1> hello everyone"
+
+      -- the edit applies to the instance of every chat
+      biz ##> "! % (hello everyone) hello again"
+      biz <# "% [edited] hello again"
+      alice <# "biz> [edited] hello again"
+      bob <# "biz> [edited] hello again"
+      cath <# "#biz biz_1> [edited] hello again"
+      chatItems biz "%1" 10 `shouldReturn` [(1, "hello again")]
+      chatItems biz "@2" 1 `shouldReturn` [(1, "hello again")]
+      chatItems biz "@3" 1 `shouldReturn` [(1, "hello again")]
+      chatItems biz "#1" 1 `shouldReturn` [(1, "hello again")]
+
+      -- the feed item is removed when every instance is marked deleted
+      biz ##> "\\ % hello again"
+      -- the response of the command and the event of the last job
+      biz <### [ConsoleString "message being deleted", ConsoleString "message deleted"]
+      alice <# "biz> [marked deleted] hello again"
+      bob <# "biz> [marked deleted] hello again"
+      cath <# "#biz biz_1> [marked deleted] hello again"
+      chatItems biz "%1" 10 `shouldReturn` []
+      chatItems biz "@2" 1 `shouldReturn` [(1, "hello again [marked deleted]")]
+      chatItems biz "#1" 1 `shouldReturn` [(1, "hello again [marked deleted]")]
+
+chatItems :: HasCallStack => TestCC -> String -> Int -> IO [(Int, String)]
+chatItems cc chatRef count = do
+  cc ##> ("/_get chat " <> chatRef <> " count=" <> show count)
+  chat <$> getTermLine cc
+
+connectToBusiness :: HasCallStack => TestCC -> TestCC -> String -> String -> String -> IO ()
+connectToBusiness biz cc cLink name fullName = do
+  cc ##> ("/c " <> cLink)
+  cc <## "connection request sent!"
+  biz <## ("#" <> name <> " (" <> fullName <> "): accepting business address request...")
+  cc <## "#biz: joining the group..."
+  biz <## ("#" <> name <> ": " <> name <> "_1 joined the group")
+  cc <## "#biz: you joined the group"

tests/ChatTests/Groups.hs

@@ -6728,8 +6728,9 @@ testMembershipProfileUpdateContactDisabled =
       bob `hasContactProfiles` ["alice", "bob"]
 
       -- bob sends any message to alice, increases auth err counter
+      createCCFeed bob
       bob `send` "/feed hi all"
-      bob <##. "/feed (1)"
+      bob <# "% hi all"
       bob <## "[alice, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection"
 
       -- on next profile update from alice member, bob considers contact disabled for purposes of profile update
@@ -12403,7 +12404,7 @@ testChannelMemberUpdateEnforcement ps =
             connId <- relayConnIdToMember bob "dan"
             ts <- getCurrentTime
             let ChatController {smpAgent = bobAgent} = chatController bob
-                chatMsg = ChatMessage chatInitialVRange Nothing (XMsgUpdate sharedId (MCText "forged") M.empty Nothing Nothing Nothing Nothing)
+                chatMsg = ChatMessage chatInitialVRange Nothing (XMsgUpdate sharedId (MCText "forged") M.empty Nothing Nothing Nothing Nothing Nothing)
                 fwd = GrpMsgForward (FwdMember cathMemId "cath") ts
                 body = encodeBinaryBatch [encodeFwdElement fwd (VMUnsigned chatMsg)]
             sent <- runExceptT $ sendMessages bobAgent [(connId, PQEncOff, MsgFlags False, vrValue body)]

tests/ChatTests/Utils.hs

@@ -29,6 +29,7 @@ import Simplex.Chat.Markdown (viewName)
 import Simplex.Chat.Messages.CIContent (e2eInfoNoPQText, e2eInfoPQText)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Store.Direct (getContact)
+import Simplex.Chat.Store.Feeds (createFeed)
 import Simplex.Chat.Store.NoteFolders (createNoteFolder)
 import Simplex.Chat.Store.Profiles (getUserContactProfiles)
 import Simplex.Chat.Types
@@ -680,6 +681,12 @@ createCCNoteFolder cc =
     withCCUser cc $ \user ->
       runExceptT (createNoteFolder db user) >>= either (fail . show) pure
 
+createCCFeed :: TestCC -> IO ()
+createCCFeed cc =
+  withCCTransaction cc $ \db ->
+    withCCUser cc $ \user ->
+      runExceptT (createFeed db user) >>= either (fail . show) pure
+
 getProfilePictureByName :: TestCC -> String -> IO (Maybe String)
 getProfilePictureByName cc displayName =
   withTransaction (chatStore $ chatController cc) $ \db ->

tests/ProtocolTests.hs

@@ -249,7 +249,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
       ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ (mcForward Nothing (MCText "hello")) {file = Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}})
   it "x.msg.update" $
     "{\"v\":\"9\",\"event\":\"x.msg.update\",\"params\":{\"msgId\":\"AQIDBA==\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
-      #==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello") [] Nothing Nothing Nothing Nothing
+      #==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello") [] Nothing Nothing Nothing Nothing Nothing
   it "x.msg.del" $
     "{\"v\":\"9\",\"event\":\"x.msg.del\",\"params\":{\"msgId\":\"AQIDBA==\"}}"
       #==# XMsgDel (SharedMsgId "\1\2\3\4") Nothing Nothing False