dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-08-22 12:20:11 +00:00
Code Issues Packages Projects Releases Wiki Activity

agent: contact request rejection (not finished)

Browse Source
This commit is contained in:
Evgeny Poberezkin
2025-03-02 22:29:28 +00:00
parent 205d4ead1c
commit 06c676695b
4 changed files with 81 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Agent.hs
+46 -16
View File
@@ -63,6 +63,7 @@ module Simplex.Messaging.Agent
allowConnection,
acceptContact,
rejectContact,
rejectNotifyContact,
subscribeConnection,
subscribeConnections,
getConnectionMessages,
@@ -305,7 +306,7 @@ createConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:. newConnAs
{-# INLINE createConnectionAsync #-}
-- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id
joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
joinConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId enableNtfs
{-# INLINE joinConnectionAsync #-}
@@ -315,7 +316,7 @@ allowConnectionAsync c = withAgentEnv c .:: allowConnectionAsync' c
{-# INLINE allowConnectionAsync #-}
-- | Accept contact after REQ notification (ACPT command) asynchronously, synchronous response is new connection id
acceptContactAsync :: AgentClient -> ACorrId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
acceptContactAsync :: AgentClient -> ACorrId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
acceptContactAsync c aCorrId enableNtfs = withAgentEnv c .:: acceptContactAsync' c aCorrId enableNtfs
{-# INLINE acceptContactAsync #-}
@@ -372,15 +373,20 @@ allowConnection c = withAgentEnv c .:. allowConnection' c
{-# INLINE allowConnection #-}
-- | Accept contact after REQ notification (ACPT command)
acceptContact :: AgentClient -> ConnId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured
acceptContact :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured
acceptContact c connId enableNtfs = withAgentEnv c .:: acceptContact' c connId enableNtfs
{-# INLINE acceptContact #-}
-- | Reject contact (RJCT command)
rejectContact :: AgentClient -> ConnId -> ConfirmationId -> AE ()
rejectContact :: AgentClient -> ConnId -> InvitationId -> AE ()
rejectContact c = withAgentEnv c .: rejectContact' c
{-# INLINE rejectContact #-}
-- | Reject contact after REQ notification (RJCT command) asynchronously
rejectNotifyContact :: AgentClient -> ACorrId -> InvitationId -> RejectionInfo -> AE ConnId
rejectNotifyContact c = withAgentEnv c .:. rejectNotifyContact' c
{-# INLINE rejectContactAsync #-}
-- | Subscribe to receive connection messages (SUB command)
subscribeConnection :: AgentClient -> ConnId -> AE ()
subscribeConnection c = withAgentEnv c . subscribeConnection' c
@@ -686,8 +692,8 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do
let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
withStore c $ \db -> createNewConn db g cData cMode
joinConnAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
joinConnAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
joinConnAsync c userId corrId enableNtfs cReqUri cInfo pqSup subMode = do
withInvLock c (strEncode cReqUri) "joinConnAsync" $ do
lift (compatibleInvitationUri cReqUri) >>= \case
Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do
@@ -698,8 +704,6 @@ joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup
enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
pure connId
Nothing -> throwE $ AGENT A_VERSION
joinConnAsync _c _userId _corrId _enableNtfs (CRContactUri _) _subMode _cInfo _pqEncryption =
throwE $ CMD PROHIBITED "joinConnAsync"
allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
allowConnectionAsync' c corrId connId confId ownConnInfo =
@@ -716,14 +720,36 @@ allowConnectionAsync' c corrId connId confId ownConnInfo =
-- while marking invitation as accepted inside "lock level transaction" after successful `joinConnAsync`.
acceptContactAsync' :: AgentClient -> ACorrId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
acceptContactAsync' c corrId enableNtfs invId ownConnInfo pqSupport subMode = do
Invitation {contactConnId, connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId
withStore c (`getConn` contactConnId) >>= \case
SomeConn _ (ContactConnection ConnData {userId} _) -> do
withStore' c $ \db -> acceptInvitation db invId ownConnInfo
joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do
withStore' c (`unacceptInvitation` invId)
throwE err
_ -> throwE $ CMD PROHIBITED "acceptContactAsync"
(connReq, ContactConnection ConnData {userId} _) <- getContactRequest c invId
withStore' c $ \db -> acceptInvitation db invId ownConnInfo
joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do
withStore' c (`unacceptInvitation` invId)
throwE err
rejectNotifyContact' :: AgentClient -> ACorrId -> InvitationId -> RejectionInfo -> AM ConnId
rejectNotifyContact' c corrId enableNtfs invId rejectionInfo = do
(connReq, ContactConnection ConnData {userId} _) <- getContactRequest c invId
withInvLock c (strEncode connReq) "rejectNotifyContact" $ do
withStore' c $ \db -> rejectInvitation db invId rejectionInfo
lift (compatibleInvitationUri connReq) >>= \case
Just (qInfo@(Compatible qInfo'), Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do
let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
q <- newSndQueue userId "" qInfo
g <- asks random
(connId, sq) <- createSndConn db g cData q
storeRejection c cData sq =<< mkAgentRejection c cData sq srv rejectionInfo
lift $ submitPendingMsg c cData sq
pure connId
Nothing -> throwE $ AGENT A_VERSION
getContactRequest :: AgentClient -> InvitationId -> AM (ConnectionRequestUri 'CMInvitation, Connection 'CContact)
getContactRequest c invId = do
(connReq, SomeConn _ conn) <- withStore c $ \db -> do
Invitation {contactConnId, connReq} <- getInvitation db "acceptContactAsync'" invId
(connReq,) <$> getConn db contactConnId
case conn of
ContactConnection {} -> pure (connReq, conn)
_ -> throwE $ CMD PROHIBITED "getContactRequest"
ackMessageAsync' :: AgentClient -> ACorrId -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AM ()
ackMessageAsync' c corrId connId msgId rcptInfo_ = do
@@ -1505,6 +1531,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
resp <- tryError $ case msgType of
AM_CONN_INFO -> sendConfirmation c sq msgBody
AM_CONN_INFO_REPLY -> sendConfirmation c sq msgBody
AM_REJECTION -> sendRejection c sq msgBody
_ -> case pendingMsgPrepData_ of
Nothing -> sendAgentMessage c sq msgFlags msgBody
Just PendingMsgPrepData {encryptKey, paddedLen, sndMsgBody} -> do
@@ -1523,6 +1550,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
case msgType of
AM_CONN_INFO -> connError msgId NOT_AVAILABLE
AM_CONN_INFO_REPLY -> connError msgId NOT_AVAILABLE
AM_REJECTION -> connError msgId NOT_AVAILABLE
_ -> do
expireTs <- addUTCTime (-quotaExceededTimeout) <$> liftIO getCurrentTime
if internalTs < expireTs
@@ -1535,6 +1563,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
case msgType of
AM_CONN_INFO -> connError msgId NOT_AVAILABLE
AM_CONN_INFO_REPLY -> connError msgId NOT_AVAILABLE
AM_REJECTION -> connError msgId NOT_AVAILABLE
AM_RATCHET_INFO -> connError msgId NOT_AVAILABLE
-- in duplexHandshake mode (v2) HELLO is only sent once, without retrying,
-- because the queue must be secured by the time the confirmation or the first HELLO is received
@@ -1575,6 +1604,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq@SndQueue {userI
| sndSecure -> notify (CON pqEncryption) >> setStatus Active
| otherwise -> setStatus Confirmed
AM_CONN_INFO_REPLY -> setStatus Confirmed
AM_REJECTION -> setStatus Rejected -- TODO notify
AM_RATCHET_INFO -> pure ()
AM_HELLO_ -> do
withStore' c $ \db -> setSndQueueStatus db sq Active
src/Simplex/Messaging/Agent/Client.hs
+7
View File
@@ -1565,6 +1565,13 @@ sendConfirmation c sq@SndQueue {userId, server, connId, sndId, sndSecure, sndPub
sendOrProxySMPMessage c userId server connId "<CONF>" spKey sndId (MsgFlags {notification = True}) msg
sendConfirmation _ _ _ = throwE $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
sendRejection :: AgentClient -> SndQueue -> ByteString -> AM (Maybe SMPServer)
sendRejection c sq@SndQueue {userId, server, connId, sndId, sndSecure, sndPublicKey, sndPrivateKey, e2ePubKey = e2ePubKey@Just {}} agentRejection = do
let clientMsg = SMP.ClientMessage SMP.PHEmpty agentRejection
msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
sendOrProxySMPMessage c userId server connId "<CONF>" Nothing sndId SMP.noMsgFlags msg
sendConfirmation _ _ _ = throwE $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
sendInvitation :: AgentClient -> UserId -> ConnId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM (Maybe SMPServer)
sendInvitation c userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) connReq connInfo = do
msg <- mkInvitation
src/Simplex/Messaging/Agent/Protocol.hs
+19
View File
@@ -334,6 +334,8 @@ deriving instance Show AEvt
type ConnInfo = ByteString
type RejectionInfo = ByteString
type SndQueueSecured = Bool
-- | Parameterized type for SMP agent events
@@ -343,6 +345,7 @@ data AEvent (e :: AEntity) where
REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender
INFO :: PQSupport -> ConnInfo -> AEvent AEConn
CON :: PQEncryption -> AEvent AEConn -- notification that connection is established
RJCT :: AEvent AEConn
END :: AEvent AEConn
DELD :: AEvent AEConn
CONNECT :: AProtocolType -> TransportHost -> AEvent AENone
@@ -730,6 +733,10 @@ data AgentMsgEnvelope
e2eEncryption_ :: Maybe (SndE2ERatchetParams 'C.X448),
encConnInfo :: ByteString
}
| AgentRjctEnvelope
{ agentVersion :: VersionSMPA,
rejectionInfo :: ByteString -- this message is only encrypted with per-queue E2E, not with double ratchet,
}
| AgentMsgEnvelope
{ agentVersion :: VersionSMPA,
encAgentMessage :: ByteString
@@ -750,6 +757,8 @@ instance Encoding AgentMsgEnvelope where
smpEncode = \case
AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo} ->
smpEncode (agentVersion, 'C', e2eEncryption_, Tail encConnInfo)
AgentRjctEnvelope {agentVersion, rejectionInfo} ->
smpEncode (agentVersion, 'J', Tail rejectionInfo)
AgentMsgEnvelope {agentVersion, encAgentMessage} ->
smpEncode (agentVersion, 'M', Tail encAgentMessage)
AgentInvitation {agentVersion, connReq, connInfo} ->
@@ -762,6 +771,9 @@ instance Encoding AgentMsgEnvelope where
'C' -> do
(e2eEncryption_, Tail encConnInfo) <- smpP
pure AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo}
'J' -> do
Tail encConnInfo <- smpP
pure AgentRjctEnvelope {agentVersion, rejectionInfo}
'M' -> do
Tail encAgentMessage <- smpP
pure AgentMsgEnvelope {agentVersion, encAgentMessage}
@@ -784,6 +796,7 @@ data AgentMessage
| -- AgentConnInfoReply is used by accepting party in duplexHandshake mode (v2), allowing to include reply queue(s) in the initial confirmation.
-- It made removed REPLY message unnecessary.
AgentConnInfoReply (NonEmpty SMPQueueInfo) ConnInfo
| AgentRejection ConnRejection
| AgentRatchetInfo ByteString
| AgentMessage APrivHeader AMessage
deriving (Show)
@@ -792,12 +805,14 @@ instance Encoding AgentMessage where
smpEncode = \case
AgentConnInfo cInfo -> smpEncode ('I', Tail cInfo)
AgentConnInfoReply smpQueues cInfo -> smpEncode ('D', smpQueues, Tail cInfo) -- 'D' stands for "duplex"
AgentRejection info -> smpEncode ('J', Tail info)
AgentRatchetInfo info -> smpEncode ('R', Tail info)
AgentMessage hdr aMsg -> smpEncode ('M', hdr, aMsg)
smpP =
smpP >>= \case
'I' -> AgentConnInfo . unTail <$> smpP
'D' -> AgentConnInfoReply <$> smpP <*> (unTail <$> smpP)
'J' -> AgentRejection . unTail <$> smpP
'R' -> AgentRatchetInfo . unTail <$> smpP
'M' -> AgentMessage <$> smpP <*> smpP
_ -> fail "bad AgentMessage"
@@ -806,6 +821,7 @@ instance Encoding AgentMessage where
data AgentMessageType
= AM_CONN_INFO
| AM_CONN_INFO_REPLY
| AM_REJECTION
| AM_RATCHET_INFO
| AM_HELLO_
| AM_A_MSG_
@@ -822,6 +838,7 @@ instance Encoding AgentMessageType where
smpEncode = \case
AM_CONN_INFO -> "C"
AM_CONN_INFO_REPLY -> "D"
AM_REJECTION -> "J"
AM_RATCHET_INFO -> "S"
AM_HELLO_ -> "H"
AM_A_MSG_ -> "M"
@@ -836,6 +853,7 @@ instance Encoding AgentMessageType where
A.anyChar >>= \case
'C' -> pure AM_CONN_INFO
'D' -> pure AM_CONN_INFO_REPLY
'J' -> pure AM_REJECTION
'S' -> pure AM_RATCHET_INFO
'H' -> pure AM_HELLO_
'M' -> pure AM_A_MSG_
@@ -855,6 +873,7 @@ agentMessageType :: AgentMessage -> AgentMessageType
agentMessageType = \case
AgentConnInfo _ -> AM_CONN_INFO
AgentConnInfoReply {} -> AM_CONN_INFO_REPLY
AgentRejection -> AM_REJECTION
AgentRatchetInfo _ -> AM_RATCHET_INFO
AgentMessage _ aMsg -> aMessageType aMsg
src/Simplex/Messaging/Agent/Store/AgentStore.hs
+9
View File
@@ -86,6 +86,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
createInvitation,
getInvitation,
acceptInvitation,
rejectInvitation,
unacceptInvitation,
deleteInvitation,
-- Messages
@@ -727,6 +728,7 @@ getInvitation db cxt invitationId =
FROM conn_invitations
WHERE invitation_id = ?
AND accepted = 0
AND rejected = 0
|]
(Only (Binary invitationId))
where
@@ -749,6 +751,13 @@ unacceptInvitation :: DB.Connection -> InvitationId -> IO ()
unacceptInvitation db invitationId =
DB.execute db "UPDATE conn_invitations SET accepted = 0, own_conn_info = NULL WHERE invitation_id = ?" (Only (Binary invitationId))
rejectInvitation :: DB.Connection -> InvitationId -> ByteString -> IO ()
rejectInvitation db invitationId rejectionInfo = do
DB.execute
db
"UPDATE conn_invitations SET rejected = 1, rejection_info = ? WHERE invitation_id = ?"
(Binary rejectionInfo, Binary invitationId)
deleteInvitation :: DB.Connection -> ConnId -> InvitationId -> IO (Either StoreError ())
deleteInvitation db contactConnId invId =
getConn db contactConnId $>>= \case