From 06c676695b7ecd3cc134f0308524b9c31dc0e2e9 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 2 Mar 2025 22:29:28 +0000 Subject: [PATCH] agent: contact request rejection (not finished) --- src/Simplex/Messaging/Agent.hs | 62 ++++++++++++++----- src/Simplex/Messaging/Agent/Client.hs | 7 +++ src/Simplex/Messaging/Agent/Protocol.hs | 19 ++++++ .../Messaging/Agent/Store/AgentStore.hs | 9 +++ 4 files changed, 81 insertions(+), 16 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index d98fd5858..4a5bf6bf4 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -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 diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 37f01752f..4c559c10e 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -1565,6 +1565,13 @@ sendConfirmation c sq@SndQueue {userId, server, connId, sndId, sndSecure, sndPub sendOrProxySMPMessage c userId server connId "" 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 "" 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 diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 365ef0766..26593c668 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -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 diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index 33beab129..0e1a93adf 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -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