blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: entity locks (#3962)

Browse Source 
* core: entity locks

* more locks

* update sha256map

* add delay

* clean up

* empty

* fix tests

* empty

* empty

* more delays

* empty

* comment delays

* Revert "comment delays"

This reverts commit 4245b545fb.

* Revert "Revert "comment delays""

This reverts commit f803386945.

* take lock in the beginning of processing loop

* empty

* empty

* remove lock

* rework file locks

* empty

* fix

* empty

* add connection locks

* empty

* fix test

* empty

* remove commented delays

* add to debug locks

* update

* refactor

* refactor

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
This commit is contained in:
spaced4ndy
2024-04-04 22:24:42 +04:00
committed by GitHub
parent a725d2efac
commit 069395c2a0
12 changed files with 255 additions and 178 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Controller.hs
+8 -7
View File
@@ -59,7 +59,7 @@ import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Protocol
import Simplex.Chat.Remote.AppVersion
import Simplex.Chat.Remote.Types
import Simplex.Chat.Store (AutoAccept, StoreError (..), UserContactLink, UserMsgReceiptSettings)
import Simplex.Chat.Store (AutoAccept, ChatLockEntity, StoreError (..), UserContactLink, UserMsgReceiptSettings)
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Util (liftIOEither)
@@ -165,7 +165,7 @@ defaultChatHooks =
ChatHooks
{ preCmdHook = \_ -> pure . Right,
eventHook = \_ -> pure
}
}
data DefaultAgentServers = DefaultAgentServers
{ smp :: NonEmpty SMPServerWithAuth,
@@ -208,6 +208,7 @@ data ChatController = ChatController
connNetworkStatuses :: TMap AgentConnId NetworkStatus,
subscriptionMode :: TVar SubscriptionMode,
chatLock :: Lock,
entityLocks :: TMap ChatLockEntity Lock,
sndFiles :: TVar (Map Int64 Handle),
rcvFiles :: TVar (Map Int64 Handle),
currentCalls :: TMap ContactId Call,
@@ -491,9 +492,9 @@ data ChatCommand
| GetAgentSubsDetails
| GetAgentWorkers
| GetAgentWorkersDetails
-- The parser will return this command for strings that start from "//".
-- This command should be processed in preCmdHook
| CustomChatCommand ByteString
| -- The parser will return this command for strings that start from "//".
-- This command should be processed in preCmdHook
CustomChatCommand ByteString
deriving (Show)
allowRemoteCommand :: ChatCommand -> Bool -- XXX: consider using Relay/Block/ForceLocal
@@ -731,7 +732,7 @@ data ChatResponse
| CRContactPQEnabled {user :: User, contact :: Contact, pqEnabled :: PQEncryption}
| CRSQLResult {rows :: [Text]}
| CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
| CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks}
| CRDebugLocks {chatLockName :: Maybe String, chatEntityLocks :: Map String String, agentLocks :: AgentLocks}
| CRAgentStats {agentStats :: [[String]]}
| CRAgentWorkersDetails {agentWorkersDetails :: AgentWorkersDetails}
| CRAgentWorkersSummary {agentWorkersSummary :: AgentWorkersSummary}
@@ -1353,7 +1354,7 @@ handleDBErrors =
[ E.Handler $ \(e :: SQLError) ->
let se = SQL.sqlError e
busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked
in pure . Left . ChatErrorStore $ if busy then SEDBBusyError $ show se else SEDBException $ show e,
in pure . Left . ChatErrorStore $ if busy then SEDBBusyError $ show se else SEDBException $ show e,
E.Handler $ \(E.SomeException e) -> pure . Left . ChatErrorStore . SEDBException $ show e
]
src/Simplex/Chat/Protocol.hs
+1 -1
View File
@@ -48,7 +48,7 @@ import Simplex.Chat.Types
import Simplex.Chat.Types.Util
import Simplex.Messaging.Agent.Protocol (VersionSMPA, pqdrSMPAgentVersion)
import Simplex.Messaging.Compression (compress1, decompressBatch)
import Simplex.Messaging.Crypto.Ratchet (PQSupport (..), pattern PQSupportOn, pattern PQSupportOff)
import Simplex.Messaging.Crypto.Ratchet (PQSupport (..), pattern PQSupportOff, pattern PQSupportOn)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
src/Simplex/Chat/Store.hs
+1
View File
@@ -1,6 +1,7 @@
module Simplex.Chat.Store
( SQLiteStore,
StoreError (..),
ChatLockEntity (..),
UserMsgReceiptSettings (..),
UserContactLink (..),
AutoAccept (..),
src/Simplex/Chat/Store/Connections.hs
+28 -1
View File
@@ -3,11 +3,13 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Store.Connections
( getConnectionEntity,
( getChatLockEntity,
getConnectionEntity,
getConnectionEntityByConnReq,
getContactConnEntityByConnReqHash,
getConnectionsToSubscribe,
@@ -37,6 +39,31 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
import Simplex.Messaging.Util (eitherToMaybe)
getChatLockEntity :: DB.Connection -> AgentConnId -> ExceptT StoreError IO ChatLockEntity
getChatLockEntity db agentConnId = do
((connId, connType) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId)) <-
ExceptT . firstRow id (SEConnectionNotFound agentConnId) $
DB.query
db
[sql|
SELECT connection_id, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id
FROM connections
WHERE agent_conn_id = ?
|]
(Only agentConnId)
let err = throwError $ SEInternalError $ "connection " <> show connType <> " without entity"
case connType of
ConnMember -> maybe err (fmap CLGroup . getMemberGroupId) groupMemberId
ConnContact -> pure $ maybe (CLConnection connId) CLContact contactId
ConnSndFile -> maybe err (pure . CLFile) sndFileId
ConnRcvFile -> maybe err (pure . CLFile) rcvFileId
ConnUserContact -> maybe err (pure . CLUserContact) userContactLinkId
where
getMemberGroupId :: GroupMemberId -> ExceptT StoreError IO GroupId
getMemberGroupId groupMemberId =
ExceptT . firstRow fromOnly (SEInternalError "group member connection group_id not found") $
DB.query db "SELECT group_id FROM group_members WHERE group_member_id = ?" (Only groupMemberId)
getConnectionEntity :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
c@Connection {connType, entityId} <- getConnection_
src/Simplex/Chat/Store/Files.hs
+3 -3
View File
@@ -336,10 +336,10 @@ setSndFTAgentDeleted db User {userId} fileId = do
"UPDATE files SET agent_snd_file_deleted = 1, updated_at = ? WHERE user_id = ? AND file_id = ?"
(currentTs, userId, fileId)
getXFTPSndFileDBId :: DB.Connection -> User -> AgentSndFileId -> ExceptT StoreError IO FileTransferId
getXFTPSndFileDBId db User {userId} aSndFileId =
getXFTPSndFileDBId :: DB.Connection -> AgentSndFileId -> ExceptT StoreError IO FileTransferId
getXFTPSndFileDBId db aSndFileId =
ExceptT . firstRow fromOnly (SESndFileNotFoundXFTP aSndFileId) $
DB.query db "SELECT file_id FROM files WHERE user_id = ? AND agent_snd_file_id = ?" (userId, aSndFileId)
DB.query db "SELECT file_id FROM files WHERE agent_snd_file_id = ?" (Only aSndFileId)
getXFTPRcvFileDBId :: DB.Connection -> AgentRcvFileId -> ExceptT StoreError IO FileTransferId
getXFTPRcvFileDBId db aRcvFileId =
src/Simplex/Chat/Store/Shared.hs
+9
View File
@@ -45,6 +45,15 @@ import Simplex.Messaging.Util (allFinally)
import Simplex.Messaging.Version
import UnliftIO.STM
data ChatLockEntity
= CLInvitation ByteString
| CLConnection Int64
| CLContact ContactId
| CLGroup GroupId
| CLUserContact Int64
| CLFile Int64
deriving (Eq, Ord)
-- These error type constructors must be added to mobile apps
data StoreError
= SEDuplicateName
src/Simplex/Chat/View.hs
+3 -2
View File
@@ -351,8 +351,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
<> (" :: avg: " <> sShow timeAvg <> " ms")
<> (" :: " <> plain (T.unwords $ T.lines query))
in ("Chat queries" : map viewQuery chatQueries) <> [""] <> ("Agent queries" : map viewQuery agentQueries)
CRDebugLocks {chatLockName, agentLocks} ->
CRDebugLocks {chatLockName, chatEntityLocks, agentLocks} ->
[ maybe "no chat lock" (("chat lock: " <>) . plain) chatLockName,
plain $ "chat entity locks: " <> LB.unpack (J.encode chatEntityLocks),
plain $ "agent locks: " <> LB.unpack (J.encode agentLocks)
]
CRAgentStats stats -> map (plain . intercalate ",") stats
@@ -1595,7 +1596,7 @@ standaloneUploadComplete FileTransferMeta {fileId, fileName} = \case
[] -> [fileTransferStr fileId fileName <> " upload complete."]
uris ->
fileTransferStr fileId fileName <> " upload complete. download with:"
: map plain uris
: map plain uris
sndFile :: SndFileTransfer -> StyledString
sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName