mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-25 14:14:39 +00:00
core: update agent protocol to parameterize by entity type (#1988)
* core: update agent protocol to parameterize by entity type * update simplexmq
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
1b7b9da07c
commit
f2f4b26c35
+1
-1
@@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/simplexmq.git
|
||||
tag: 552759018e493cf224d2451a3dabee2401ab3853
|
||||
tag: 8fde8e1344699cdcdc67709595c9285cd06bbef3
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
{
|
||||
"https://github.com/simplex-chat/simplexmq.git"."552759018e493cf224d2451a3dabee2401ab3853" = "06jv5ax4482jkrfmr3alffixay1cvpjycqnhk53xkm8midhx8mg5";
|
||||
"https://github.com/simplex-chat/simplexmq.git"."8fde8e1344699cdcdc67709595c9285cd06bbef3" = "1nvxmmfq3k1a8l14lksxdsqzxq19kmvg2kpiryqdks3k946x6pzn";
|
||||
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
|
||||
"https://github.com/kazu-yamamoto/http2.git"."b3b62ba36900babfde1a073c705cbccc2685f385" = "076gl9mcm9gxcif5662g5ar0pd817657mc46y99ighria3z36cmz";
|
||||
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
|
||||
|
||||
+16
-15
@@ -1350,7 +1350,7 @@ processChatCommand = \case
|
||||
updateGroupProfileByName gName $ \p ->
|
||||
p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
|
||||
QuitChat -> liftIO exitSuccess
|
||||
ShowVersion -> pure $ CRVersionInfo $ coreVersionInfo $(buildTimestampQ) $(simplexmqCommitQ)
|
||||
ShowVersion -> pure $ CRVersionInfo $ coreVersionInfo $(buildTimestampQ) "" -- $(simplexmqCommitQ)
|
||||
DebugLocks -> do
|
||||
chatLockName <- atomically . tryReadTMVar =<< asks chatLock
|
||||
agentLocks <- withAgent debugAgentLocks
|
||||
@@ -1842,7 +1842,7 @@ agentSubscriber = do
|
||||
q <- asks $ subQ . smpAgent
|
||||
l <- asks chatLock
|
||||
forever $ do
|
||||
(corrId, connId, msg) <- atomically $ readTBQueue q
|
||||
(corrId, connId, APC _ msg) <- atomically $ readTBQueue q
|
||||
let name = "agentSubscriber connId=" <> str connId <> " corrId=" <> str corrId <> " msg=" <> str (aCommandTag msg)
|
||||
withLock l name . void . runExceptT $
|
||||
processAgentMessage corrId connId msg `catchError` (toView . CRChatError Nothing)
|
||||
@@ -2066,7 +2066,7 @@ expireChatItems user@User {userId} ttl sync = do
|
||||
membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db user gInfo
|
||||
forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m
|
||||
|
||||
processAgentMessage :: forall m. ChatMonad m => ACorrId -> ConnId -> ACommand 'Agent -> m ()
|
||||
processAgentMessage :: forall e m. (AEntityI e, ChatMonad m) => ACorrId -> ConnId -> ACommand 'Agent e -> m ()
|
||||
processAgentMessage _ "" msg =
|
||||
processAgentMessageNoConn msg `catchError` (toView . CRChatError Nothing)
|
||||
processAgentMessage _ connId (DEL_RCVQ srv qId err_) =
|
||||
@@ -2078,7 +2078,7 @@ processAgentMessage corrId connId msg =
|
||||
Just user -> processAgentMessageConn user corrId connId msg `catchError` (toView . CRChatError (Just user))
|
||||
_ -> throwChatError $ CENoConnectionUser (AgentConnId connId)
|
||||
|
||||
processAgentMessageNoConn :: forall m. ChatMonad m => ACommand 'Agent -> m ()
|
||||
processAgentMessageNoConn :: forall e m. ChatMonad m => ACommand 'Agent e -> m ()
|
||||
processAgentMessageNoConn = \case
|
||||
CONNECT p h -> hostEvent $ CRHostConnected p h
|
||||
DISCONNECT p h -> hostEvent $ CRHostDisconnected p h
|
||||
@@ -2088,13 +2088,14 @@ processAgentMessageNoConn = \case
|
||||
DEL_USER agentUserId -> toView $ CRAgentUserDeleted agentUserId
|
||||
_ -> pure ()
|
||||
where
|
||||
hostEvent :: ChatResponse -> m ()
|
||||
hostEvent = whenM (asks $ hostEvents . config) . toView
|
||||
serverEvent srv@(SMPServer host _ _) conns event str = do
|
||||
cs <- withStore' $ \db -> getConnectionsContacts db conns
|
||||
toView $ event srv cs
|
||||
showToast ("server " <> str) (safeDecodeUtf8 $ strEncode host)
|
||||
|
||||
processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent -> m ()
|
||||
processAgentMessageConn :: forall e m. (AEntityI e, ChatMonad m) => User -> ACorrId -> ConnId -> ACommand 'Agent e -> m ()
|
||||
processAgentMessageConn user _ agentConnId END =
|
||||
withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= \case
|
||||
RcvDirectMsgConnection _ (Just ct@Contact {localDisplayName = c}) -> do
|
||||
@@ -2128,14 +2129,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
isMember memId GroupInfo {membership} members =
|
||||
sameMemberId memId membership || isJust (find (sameMemberId memId) members)
|
||||
|
||||
agentMsgConnStatus :: ACommand 'Agent -> Maybe ConnStatus
|
||||
agentMsgConnStatus :: ACommand 'Agent e -> Maybe ConnStatus
|
||||
agentMsgConnStatus = \case
|
||||
CONF {} -> Just ConnRequested
|
||||
INFO _ -> Just ConnSndReady
|
||||
CON -> Just ConnReady
|
||||
_ -> Nothing
|
||||
|
||||
processDirectMessage :: ACommand 'Agent -> ConnectionEntity -> Connection -> Maybe Contact -> m ()
|
||||
processDirectMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> Maybe Contact -> m ()
|
||||
processDirectMessage agentMsg connEntity conn@Connection {connId, viaUserContactLink, groupLinkId, customUserProfileId} = \case
|
||||
Nothing -> case agentMsg of
|
||||
CONF confId _ connInfo -> do
|
||||
@@ -2282,7 +2283,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
-- TODO add debugging output
|
||||
_ -> pure ()
|
||||
|
||||
processGroupMessage :: ACommand 'Agent -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> m ()
|
||||
processGroupMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> m ()
|
||||
processGroupMessage agentMsg connEntity conn@Connection {connId} gInfo@GroupInfo {groupId, localDisplayName = gName, groupProfile, membership, chatSettings} m = case agentMsg of
|
||||
INV (ACR _ cReq) ->
|
||||
withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} ->
|
||||
@@ -2439,7 +2440,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
-- TODO add debugging output
|
||||
_ -> pure ()
|
||||
|
||||
processSndFileConn :: ACommand 'Agent -> ConnectionEntity -> Connection -> SndFileTransfer -> m ()
|
||||
processSndFileConn :: ACommand 'Agent e -> ConnectionEntity -> Connection -> SndFileTransfer -> m ()
|
||||
processSndFileConn agentMsg connEntity conn ft@SndFileTransfer {fileId, fileName, fileStatus} =
|
||||
case agentMsg of
|
||||
-- SMP CONF for SndFileConnection happens for direct file protocol
|
||||
@@ -2483,7 +2484,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
-- TODO add debugging output
|
||||
_ -> pure ()
|
||||
|
||||
processRcvFileConn :: ACommand 'Agent -> ConnectionEntity -> Connection -> RcvFileTransfer -> m ()
|
||||
processRcvFileConn :: ACommand 'Agent e -> ConnectionEntity -> Connection -> RcvFileTransfer -> m ()
|
||||
processRcvFileConn agentMsg connEntity conn ft@RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}, grpMemberId} =
|
||||
case agentMsg of
|
||||
INV (ACR _ cReq) ->
|
||||
@@ -2578,7 +2579,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
withAckMessage agentConnId cmdId meta a
|
||||
Nothing -> a
|
||||
|
||||
processUserContactRequest :: ACommand 'Agent -> ConnectionEntity -> Connection -> UserContact -> m ()
|
||||
processUserContactRequest :: ACommand 'Agent e -> ConnectionEntity -> Connection -> UserContact -> m ()
|
||||
processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId} = case agentMsg of
|
||||
REQ invId _ connInfo -> do
|
||||
ChatMessage {chatMsgEvent} <- parseChatMessage connInfo
|
||||
@@ -2629,20 +2630,20 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
toView $ CRConnectionDisabled connEntity
|
||||
_ -> pure ()
|
||||
|
||||
updateChatLock :: MsgEncodingI e => String -> ChatMsgEvent e -> m ()
|
||||
updateChatLock :: MsgEncodingI enc => String -> ChatMsgEvent enc -> m ()
|
||||
updateChatLock name event = do
|
||||
l <- asks chatLock
|
||||
atomically $ tryReadTMVar l >>= mapM_ (swapTMVar l . (<> s))
|
||||
where
|
||||
s = " " <> name <> "=" <> B.unpack (strEncode $ toCMEventTag event)
|
||||
|
||||
withCompletedCommand :: Connection -> ACommand 'Agent -> (CommandData -> m ()) -> m ()
|
||||
withCompletedCommand :: Connection -> ACommand 'Agent e -> (CommandData -> m ()) -> m ()
|
||||
withCompletedCommand Connection {connId} agentMsg action = do
|
||||
let agentMsgTag = aCommandTag agentMsg
|
||||
let agentMsgTag = APCT (sAEntity @e) $ aCommandTag agentMsg
|
||||
cmdData_ <- withStore' $ \db -> getCommandDataByCorrId db user corrId
|
||||
case cmdData_ of
|
||||
Just cmdData@CommandData {cmdId, cmdConnId = Just cmdConnId', cmdFunction}
|
||||
| connId == cmdConnId' && (agentMsgTag == commandExpectedResponse cmdFunction || agentMsgTag == ERR_) -> do
|
||||
| connId == cmdConnId' && (agentMsgTag == commandExpectedResponse cmdFunction || agentMsgTag == APCT SAEConn ERR_) -> do
|
||||
withStore' $ \db -> deleteCommand db user cmdId
|
||||
action cmdData
|
||||
| otherwise -> err cmdId $ "not matching connection id or unexpected response, corrId = " <> show corrId
|
||||
|
||||
+13
-11
@@ -49,7 +49,7 @@ import Database.SQLite.Simple.ToField (ToField (..))
|
||||
import GHC.Generics (Generic)
|
||||
import GHC.Records.Compat
|
||||
import Simplex.FileTransfer.Description (FileDigest)
|
||||
import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId)
|
||||
import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, SAEntity (..))
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON)
|
||||
import Simplex.Messaging.Protocol (AProtoServerWithAuth, ProtoServerWithAuth, ProtocolTypeI)
|
||||
@@ -1939,17 +1939,19 @@ instance TextEncoding CommandFunction where
|
||||
CFAckMessage -> "ack_message"
|
||||
CFDeleteConn -> "delete_conn"
|
||||
|
||||
commandExpectedResponse :: CommandFunction -> ACommandTag 'Agent
|
||||
commandExpectedResponse :: CommandFunction -> APartyCmdTag 'Agent
|
||||
commandExpectedResponse = \case
|
||||
CFCreateConnGrpMemInv -> INV_
|
||||
CFCreateConnGrpInv -> INV_
|
||||
CFCreateConnFileInvDirect -> INV_
|
||||
CFCreateConnFileInvGroup -> INV_
|
||||
CFJoinConn -> OK_
|
||||
CFAllowConn -> OK_
|
||||
CFAcceptContact -> OK_
|
||||
CFAckMessage -> OK_
|
||||
CFDeleteConn -> OK_
|
||||
CFCreateConnGrpMemInv -> t INV_
|
||||
CFCreateConnGrpInv -> t INV_
|
||||
CFCreateConnFileInvDirect -> t INV_
|
||||
CFCreateConnFileInvGroup -> t INV_
|
||||
CFJoinConn -> t OK_
|
||||
CFAllowConn -> t OK_
|
||||
CFAcceptContact -> t OK_
|
||||
CFAckMessage -> t OK_
|
||||
CFDeleteConn -> t OK_
|
||||
where
|
||||
t = APCT SAEConn
|
||||
|
||||
data CommandData = CommandData
|
||||
{ cmdId :: CommandId,
|
||||
|
||||
+1
-1
@@ -49,7 +49,7 @@ extra-deps:
|
||||
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
|
||||
# - ../simplexmq
|
||||
- github: simplex-chat/simplexmq
|
||||
commit: 552759018e493cf224d2451a3dabee2401ab3853
|
||||
commit: 8fde8e1344699cdcdc67709595c9285cd06bbef3
|
||||
# - ../direct-sqlcipher
|
||||
- github: simplex-chat/direct-sqlcipher
|
||||
commit: 34309410eb2069b029b8fc1872deb1e0db123294
|
||||
|
||||
Reference in New Issue
Block a user