core: inactive connections/members

cabal.project

@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: bd67844169d2206d8543c01e6ed966315115b0e3
+    tag: 199f85ec62bcbadd11dc05bb97cce6556dafb384
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."bd67844169d2206d8543c01e6ed966315115b0e3" = "1g218q15hrg21h8gyidavfys5zx8dzmxq7iwfm5bfaw71grpd7pn";
+  "https://github.com/simplex-chat/simplexmq.git"."199f85ec62bcbadd11dc05bb97cce6556dafb384" = "0x5c29x5h1832hks0wpxy84x16rn13pi9zd2j9x8lvb3y8h0ddk0";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";

simplex-chat.cabal

@@ -145,6 +145,7 @@ library
       Simplex.Chat.Migrations.M20240501_chat_deleted
       Simplex.Chat.Migrations.M20240510_chat_items_via_proxy
       Simplex.Chat.Migrations.M20240515_rcv_files_user_approved_relays
+      Simplex.Chat.Migrations.M20240528_quota_err_counter
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared

src/Simplex/Chat.hs

@@ -12,7 +12,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Chat where
 
@@ -362,7 +362,7 @@
     . map (\ServerCfg {server} -> server)
     . filter (\ServerCfg {enabled} -> enabled)
 
 cfgServers :: UserProtocol p => SProtocolType p -> (DefaultAgentServers -> NonEmpty (ProtoServerWithAuth p))
 cfgServers p DefaultAgentServers {smp, xftp} = case p of
   SPSMP -> smp
   SPXFTP -> xftp
@@ -1472,14 +1472,14 @@
     ct@Contact {activeConn} <- withStore $ \db -> getContact db vr user contactId
     case activeConn of
       Just conn -> do
-        withStore' $ \db -> setConnectionAuthErrCounter db user conn 0
+        withStore' $ \db -> setAuthErrCounter db user conn 0
         ok user
       Nothing -> throwChatError $ CEContactNotActive ct
   APIEnableGroupMember gId gMemberId -> withUser $ \user -> do
     GroupMember {activeConn} <- withStore $ \db -> getGroupMember db vr user gId gMemberId
     case activeConn of
       Just conn -> do
-        withStore' $ \db -> setConnectionAuthErrCounter db user conn 0
+        withStore' $ \db -> setAuthErrCounter db user conn 0
         ok user
       _ -> throwChatError CEGroupMemberNotActive
   SetShowMessages cName ntfOn -> updateChatSettings cName (\cs -> cs {enableNtfs = ntfOn})
@@ -3960,14 +3960,19 @@
           withAckMessage' "new contact msg" agentConnId meta $
             void $
               saveDirectRcvMSG conn meta msgBody
-        SENT msgId _proxy ->
+        SENT msgId _proxy -> do
+          void $ continueSending connEntity conn
           sentMsgDeliveryEvent conn msgId
         OK ->
           -- [async agent commands] continuation on receiving OK
           when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
+        QCONT ->
+          void $ continueSending connEntity conn
+        MWARN _ err ->
+          processConnMWARN connEntity conn err
         MERR _ err -> do
           toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
-          incAuthErrCounter connEntity conn err
+          processConnMERR connEntity conn err
         MERRS _ err -> do
           -- error cannot be AUTH error here
           toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
@@ -4098,6 +4103,7 @@
                 let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
                 when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True
         SENT msgId proxy -> do
+          void $ continueSending connEntity conn
           sentMsgDeliveryEvent conn msgId
           checkSndInlineFTComplete conn msgId
           ci_ <- withStore $ \db -> do
@@ -4138,12 +4144,15 @@
         OK ->
           -- [async agent commands] continuation on receiving OK
           when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
-        MWARN msgId err ->
+        QCONT ->
+          void $ continueSending connEntity conn
+        MWARN msgId err -> do
           updateDirectItemStatus ct conn msgId (CISSndWarning $ agentSndError err)
+          processConnMWARN connEntity conn err
         MERR msgId err -> do
           updateDirectItemStatus ct conn msgId (CISSndError $ agentSndError err)
           toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
-          incAuthErrCounter connEntity conn err
+          processConnMERR connEntity conn err
         MERRS msgIds err -> do
           -- error cannot be AUTH error here
           updateDirectItemsStatus ct conn (L.toList msgIds) (CISSndError $ agentSndError err)
@@ -4492,9 +4501,11 @@
         withAckMessage' "group rcvd" agentConnId msgMeta $
           groupMsgReceived gInfo m conn msgMeta msgRcpt
       SENT msgId proxy -> do
+        continued <- continueSending connEntity conn
         sentMsgDeliveryEvent conn msgId
         checkSndInlineFTComplete conn msgId
         updateGroupItemStatus gInfo m conn msgId (CISSndSent SSPComplete) (Just $ isJust proxy)
+        when continued $ sendPendingGroupMessages user m conn
       SWITCH qd phase cStats -> do
         toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats)
         when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
@@ -4530,13 +4541,17 @@
       OK ->
         -- [async agent commands] continuation on receiving OK
         when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
-      MWARN msgId err ->
+      QCONT -> do
+        continued <- continueSending connEntity conn
+        when continued $ sendPendingGroupMessages user m conn
+      MWARN msgId err -> do
         withStore' $ \db -> updateGroupItemErrorStatus db msgId (groupMemberId' m) (CISSndWarning $ agentSndError err)
+        processConnMWARN connEntity conn err
       MERR msgId err -> do
         withStore' $ \db -> updateGroupItemErrorStatus db msgId (groupMemberId' m) (CISSndError $ agentSndError err)
         -- group errors are silenced to reduce load on UI event log
         -- toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
-        incAuthErrCounter connEntity conn err
+        processConnMERR connEntity conn err
       MERRS msgIds err -> do
         let newStatus = CISSndError $ agentSndError err
         -- error cannot be AUTH error here
@@ -4666,7 +4681,7 @@
           when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
         MERR _ err -> do
           toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
-          incAuthErrCounter connEntity conn err
+          processConnMERR connEntity conn err
         ERR err -> do
           toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
           when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
@@ -4718,7 +4733,7 @@
           _ -> pure ()
       MERR _ err -> do
         toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
-        incAuthErrCounter connEntity conn err
+        processConnMERR connEntity conn err
       ERR err -> do
         toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
         when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
@@ -4758,17 +4773,40 @@
       | memberRole <= GRObserver = messageError "member is not allowed to send messages"
       | otherwise = a
 
-    incAuthErrCounter :: ConnectionEntity -> Connection -> AgentErrorType -> CM ()
-    incAuthErrCounter connEntity conn err = do
+    processConnMERR :: ConnectionEntity -> Connection -> AgentErrorType -> CM ()
+    processConnMERR connEntity conn err = do
       case err of
         SMP _ SMP.AUTH -> do
-          authErrCounter' <- withStore' $ \db -> incConnectionAuthErrCounter db user conn
+          authErrCounter' <- withStore' $ \db -> incAuthErrCounter db user conn
           when (authErrCounter' >= authErrDisableCount) $ case connEntity of
             RcvDirectMsgConnection ctConn (Just ct) -> do
               toView $ CRContactDisabled user ct {activeConn = Just ctConn {authErrCounter = authErrCounter'}}
             _ -> toView $ CRConnectionDisabled connEntity
+        SMP _ SMP.QUOTA ->
+          unless (connInactive conn) $ do
+            withStore' $ \db -> setQuotaErrCounter db user conn quotaErrSetOnMERR
+            toView $ CRConnectionInactive connEntity True
+        _ -> pure ()
+
+    processConnMWARN :: ConnectionEntity -> Connection -> AgentErrorType -> CM ()
+    processConnMWARN connEntity conn err = do
+      case err of
+        SMP _ SMP.QUOTA ->
+          unless (connInactive conn) $ do
+            quotaErrCounter' <- withStore' $ \db -> incQuotaErrCounter db user conn
+            when (quotaErrCounter' >= quotaErrInactiveCount) $
+              toView $ CRConnectionInactive connEntity True
         _ -> pure ()
 
+    continueSending :: ConnectionEntity -> Connection -> CM Bool
+    continueSending connEntity conn =
+      if connInactive conn
+        then do
+          withStore' $ \db -> setQuotaErrCounter db user conn 0
+          toView $ CRConnectionInactive connEntity False
+          pure True
+        else pure False
+
     -- TODO v5.7 / v6.0 - together with deprecating old group protocol establishing direct connections?
     -- we could save command records only for agent APIs we process continuations for (INV)
     withCompletedCommand :: forall e. AEntityI e => Connection -> ACommand 'Agent e -> (CommandData -> CM ()) -> CM ()
@@ -6726,6 +6764,7 @@
   Nothing -> pendingOrForwarded
   Just conn@Connection {connStatus}
     | connDisabled conn || connStatus == ConnDeleted -> Nothing
+    | connInactive conn -> Just MSAPending
     | connStatus == ConnSndReady || connStatus == ConnReady -> Just (MSASend conn)
     | otherwise -> pendingOrForwarded
   where

src/Simplex/Chat/Controller.hs

@@ -13,7 +13,7 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-implicit-lift #-}
 
 module Simplex.Chat.Controller where
 
@@ -752,6 +752,7 @@
   | CRAgentMsgCounts {msgCounts :: [(Text, (Int, Int))]}
   | CRContactDisabled {user :: User, contact :: Contact}
   | CRConnectionDisabled {connectionEntity :: ConnectionEntity}
+  | CRConnectionInactive {connectionEntity :: ConnectionEntity, inactive :: Bool}
   | CRAgentRcvQueueDeleted {agentConnId :: AgentConnId, server :: SMPServer, agentQueueId :: AgentQueueId, agentError_ :: Maybe AgentErrorType}
   | CRAgentConnDeleted {agentConnId :: AgentConnId}
   | CRAgentUserDeleted {agentUserId :: Int64}

src/Simplex/Chat/Migrations/M20240528_quota_err_counter.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20240528_quota_err_counter where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20240528_quota_err_counter :: Query
+m20240528_quota_err_counter =
+  [sql|
+ALTER TABLE connections ADD COLUMN quota_err_counter INTEGER NOT NULL DEFAULT 0;
+|]
+
+down_m20240528_quota_err_counter :: Query
+down_m20240528_quota_err_counter =
+  [sql|
+ALTER TABLE connections DROP COLUMN quota_err_counter;
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -289,6 +289,7 @@ CREATE TABLE connections(
   pq_encryption INTEGER NOT NULL DEFAULT 0,
   pq_snd_enabled INTEGER,
   pq_rcv_enabled INTEGER,
+  quota_err_counter INTEGER NOT NULL DEFAULT 0,
   FOREIGN KEY(snd_file_id, connection_id)
   REFERENCES snd_files(file_id, connection_id)
   ON DELETE CASCADE

src/Simplex/Chat/Store/Connections.hs

@@ -5,7 +5,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Chat.Store.Connections
   ( getChatLockEntity,
@@ -85,7 +85,7 @@
           [sql|
             SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id,
               conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id,
-              created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter,
+              created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter, quota_err_counter,
               conn_chat_version, peer_chat_min_version, peer_chat_max_version
             FROM connections
             WHERE user_id = ? AND agent_conn_id = ?