Merge remote-tracking branch 'origin/master' into ab/async-subs

tests/ChatClient.hs

@@ -401,8 +401,8 @@ testChatCfg4 cfg p1 p2 p3 p4 test = testChatN cfg testOpts [p1, p2, p3, p4] test
 concurrentlyN_ :: [IO a] -> IO ()
 concurrentlyN_ = mapConcurrently_ id
 
-serverCfg :: ServerConfig
-serverCfg =
+smpServerCfg :: ServerConfig
+smpServerCfg =
   ServerConfig
     { transports = [(serverPort, transport @TLS)],
       tbqSize = 1,
@@ -432,11 +432,15 @@ serverCfg =
       controlPort = Nothing,
       smpAgentCfg = defaultSMPClientAgentConfig,
       allowSMPProxy = False,
-      serverClientConcurrency = 16
+      serverClientConcurrency = 16,
+      information = Nothing
     }
 
 withSmpServer :: IO () -> IO ()
-withSmpServer = serverBracket (`runSMPServerBlocking` serverCfg)
+withSmpServer = withSmpServer' smpServerCfg
+
+withSmpServer' :: ServerConfig -> IO () -> IO ()
+withSmpServer' cfg = serverBracket (`runSMPServerBlocking` cfg)
 
 xftpTestPort :: ServiceName
 xftpTestPort = "7002"

tests/ChatTests/Groups.hs

@@ -1,6 +1,9 @@
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PostfixOperators #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module ChatTests.Groups where
 
@@ -13,11 +16,16 @@ import qualified Data.ByteString.Char8 as B
 import Data.List (isInfixOf)
 import qualified Data.Text as T
 import Simplex.Chat.Controller (ChatConfig (..))
+import Simplex.Chat.Options
 import Simplex.Chat.Protocol (supportedChatVRange)
 import Simplex.Chat.Store (agentStoreFile, chatStoreFile)
 import Simplex.Chat.Types (VersionRangeChat)
 import Simplex.Chat.Types.Shared (GroupMemberRole (..))
+import Simplex.Messaging.Agent.Env.SQLite
+import Simplex.Messaging.Agent.RetryInterval
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
+import Simplex.Messaging.Server.Env.STM hiding (subscriptions)
+import Simplex.Messaging.Transport
 import System.Directory (copyFile)
 import System.FilePath ((</>))
 import Test.Hspec hiding (it)
@@ -150,6 +158,8 @@ chatGroupTests = do
     it "another admin can unblock" testBlockForAllAnotherAdminUnblocks
     it "member was blocked before joining group" testBlockForAllBeforeJoining
     it "can't repeat block, unblock" testBlockForAllCantRepeat
+  describe "group member inactivity" $ do
+    it "mark member inactive on reaching quota" testGroupMemberInactive
   where
     _0 = supportedChatVRange -- don't create direct connections
     _1 = groupCreateDirectVRange
@@ -6074,3 +6084,73 @@ testBlockForAllCantRepeat =
       [alice, cath] *<# "#team bob> 3"
 
       bob #$> ("/_get chat #1 count=3", chat, [(1, "1"), (1, "2"), (1, "3")])
+
+testGroupMemberInactive :: HasCallStack => FilePath -> IO ()
+testGroupMemberInactive tmp = do
+  withSmpServer' serverCfg' $ do
+    withNewTestChatCfgOpts tmp cfg' opts' "alice" aliceProfile $ \alice -> do
+      withNewTestChatCfgOpts tmp cfg' opts' "bob" bobProfile $ \bob -> do
+        createGroup2 "team" alice bob
+
+        alice #> "#team hi"
+        bob <# "#team alice> hi"
+        bob #> "#team hey"
+        alice <# "#team bob> hey"
+
+      -- bob is offline
+      alice #> "#team 1"
+      alice #> "#team 2"
+      alice #> "#team 3"
+      alice <## "[#team bob] connection is marked as inactive"
+      -- 4 and 5 will be sent to bob as pending messages
+      alice #> "#team 4"
+      alice #> "#team 5"
+
+      pgmCount <- withCCTransaction alice $ \db ->
+        DB.query_ db "SELECT count(1) FROM pending_group_messages" :: IO [[Int]]
+      pgmCount `shouldBe` [[2]]
+
+      threadDelay 1500000
+
+      withTestChatCfgOpts tmp cfg' opts' "bob" $ \bob -> do
+        bob <## "1 contacts connected (use /cs for the list)"
+        bob <## "#team: connected to server(s)"
+        bob <# "#team alice> 1"
+        bob <# "#team alice> 2"
+        bob <#. "#team alice> skipped message ID"
+        alice <## "[#team bob] inactive connection is marked as active"
+
+        bob <# "#team alice> 4"
+        bob <# "#team alice> 5"
+
+        pgmCount' <- withCCTransaction alice $ \db ->
+          DB.query_ db "SELECT count(1) FROM pending_group_messages" :: IO [[Int]]
+        pgmCount' `shouldBe` [[0]]
+
+        -- delivery works
+        alice #> "#team hi"
+        bob <# "#team alice> hi"
+        bob #> "#team hey"
+        alice <# "#team bob> hey"
+  where
+    serverCfg' =
+      smpServerCfg
+        { transports = [("7003", transport @TLS)],
+          msgQueueQuota = 2
+        }
+    fastRetryInterval = defaultReconnectInterval {initialInterval = 50_000} -- same as in agent tests
+    cfg' =
+      testCfg
+        { agentConfig =
+            testAgentCfg
+              { quotaExceededTimeout = 1,
+                messageRetryInterval = RetryInterval2 {riFast = fastRetryInterval, riSlow = fastRetryInterval}
+              }
+        }
+    opts' =
+      testOpts
+        { coreOptions =
+            testCoreOpts
+              { smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7003"]
+              }
+        }