From 04cbed90fb9d98f38544ffb5a3a61fe260aa69e5 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sun, 30 Mar 2025 11:17:25 +0100 Subject: [PATCH] agent: set/update and delete contact short link data (#1499) * agent: set/update and delete contact short link data * delete contact link data, tests * comments * type signature for GHC 8.10.7 --- src/Simplex/Messaging/Agent.hs | 115 ++++++++++++------ src/Simplex/Messaging/Agent/Client.hs | 22 +--- .../Messaging/Agent/Store/AgentStore.hs | 26 ++-- src/Simplex/Messaging/Crypto/ShortLink.hs | 20 ++- src/Simplex/Messaging/Server.hs | 10 +- .../Messaging/Server/QueueStore/Postgres.hs | 2 +- tests/AgentTests/FunctionalAPITests.hs | 56 ++++++++- tests/ServerTests.hs | 28 +++++ 8 files changed, 202 insertions(+), 77 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index c05fcf8f6..2cedf5fbd 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -56,7 +56,10 @@ module Simplex.Messaging.Agent deleteConnectionAsync, deleteConnectionsAsync, createConnection, + setContactShortLink, + deleteContactShortLink, getConnShortLink, + deleteLocalInvShortLink, changeConnectionUser, prepareConnectionToJoin, prepareConnectionToAccept, @@ -189,7 +192,7 @@ import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId, PNMessageData (..), pnMessagesP) import Simplex.Messaging.Notifications.Types import Simplex.Messaging.Parsers (parse) -import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolType (..), ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC) +import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolType (..), ProtocolTypeI (..), QueueLinkData, SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC) import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.ServiceScheme (ServiceScheme (..)) import qualified Simplex.Messaging.TMap as TM @@ -347,21 +350,23 @@ createConnection c userId enableNtfs = withAgentEnv c .::. newConn c userId enab {-# INLINE createConnection #-} -- | Create or update user's contact connection short link --- TODO [short links] -setConnShortLink :: AgentClient -> ConnId -> ConnInfo -> AE (ConnShortLink 'CMContact) -setConnShortLink c = withAgentEnv c .: setConnShortLink' c -{-# INLINE setConnShortLink #-} +setContactShortLink :: AgentClient -> ConnId -> ConnInfo -> AE (ConnShortLink 'CMContact) +setContactShortLink c = withAgentEnv c .: setContactShortLink' c +{-# INLINE setContactShortLink #-} + +deleteContactShortLink :: AgentClient -> ConnId -> AE () +deleteContactShortLink c = withAgentEnv c . deleteContactShortLink' c +{-# INLINE deleteContactShortLink #-} -- | Get and verify data from short link. For 1-time invitations it preserves the key to allow retries getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnInfo) getConnShortLink c = withAgentEnv c .: getConnShortLink' c {-# INLINE getConnShortLink #-} --- | This irreversible deletes short link data, and it won't be retrievable again --- TODO [short links] -delInvShortLink :: AgentClient -> ConnShortLink 'CMInvitation -> AE () -delInvShortLink c = withAgentEnv c . delInvShortLink' c -{-# INLINE delInvShortLink #-} +-- | This irreversibly deletes short link data, and it won't be retrievable again +deleteLocalInvShortLink :: AgentClient -> ConnShortLink 'CMInvitation -> AE () +deleteLocalInvShortLink c = withAgentEnv c . deleteLocalInvShortLink' c +{-# INLINE deleteLocalInvShortLink #-} -- | Changes the user id associated with a connection changeConnectionUser :: AgentClient -> UserId -> ConnId -> UserId -> AE () @@ -801,11 +806,46 @@ newConn :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode newConn c userId enableNtfs cMode userData_ clientData pqInitKeys subMode = do srv <- getSMPServer c userId connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys) - (connId,) <$> newRcvConnSrv_ c userId connId enableNtfs cMode userData_ clientData pqInitKeys subMode srv + (connId,) <$> newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys subMode srv `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e -setConnShortLink' :: AgentClient -> ConnId -> ConnInfo -> AM (ConnShortLink 'CMContact) -setConnShortLink' = undefined +setContactShortLink' :: AgentClient -> ConnId -> ConnInfo -> AM (ConnShortLink 'CMContact) +setContactShortLink' c connId userData = + withConnLock c connId "setContactShortLink" $ + withStore c (`getConn` connId) >>= \case + SomeConn _ (ContactConnection _ rq) -> do + (lnkId, linkKey, d) <- prepareLinkData rq + addQueueLink c rq lnkId d + pure $ CSLContact (qServer rq) CCTContact linkKey + _ -> throwE $ CMD PROHIBITED "setContactShortLink: not contact address" + where + prepareLinkData :: RcvQueue -> AM (SMP.LinkId, LinkKey, QueueLinkData) + prepareLinkData rq@RcvQueue {server, sndId, e2ePrivKey, shortLink} = do + g <- asks random + AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config + case shortLink of + Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do + let (linkId, k) = SL.contactShortLinkKdf shortLinkKey + unless (shortLinkId == linkId) $ throwE $ INTERNAL "setContactShortLink: link ID is not derived from link" + d <- liftIO $ SL.encryptData g k $ SL.encodeSignUserData linkPrivSigKey smpAgentVRange userData + pure (linkId, shortLinkKey, (linkEncFixedData, d)) + Nothing -> do + sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g + let qUri = SMPQueueUri vr $ SMPQueueAddress server sndId (C.publicKey e2ePrivKey) False + connReq = CRContactUri $ ConnReqUriData SSSimplex smpAgentVRange [qUri] Nothing + (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq userData + (linkId, k) = SL.contactShortLinkKdf linkKey + srvData <- liftIO $ SL.encryptLinkData g k linkData + let slCreds = ShortLinkCreds linkId linkKey privSigKey (fst srvData) + withStore' c $ \db -> updateShortLinkCreds db rq slCreds + pure (linkId, linkKey, srvData) + +deleteContactShortLink' :: AgentClient -> ConnId -> AM () +deleteContactShortLink' c connId = + withConnLock c connId "deleteContactShortLink" $ + withStore c (`getConn` connId) >>= \case + SomeConn _ (ContactConnection _ rq) -> deleteQueueLink c rq + _ -> throwE $ CMD PROHIBITED "deleteContactShortLink: not contact address" -- TODO [short links] remove 1-time invitation data and link ID from the server after the message is sent. getConnShortLink' :: forall c. AgentClient -> UserId -> ConnShortLink c -> AM (ConnectionRequestUri c, ConnInfo) @@ -829,15 +869,15 @@ getConnShortLink' c userId = \case ld <- getQueueLink c userId srv linkId decryptData srv linkKey k ld where - decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, SMP.QueueLinkData) -> AM (ConnectionRequestUri c, ConnInfo) + decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (ConnectionRequestUri c, ConnInfo) decryptData srv linkKey k (sndId, d) = do r@(cReq, _) <- liftEither $ SL.decryptLinkData @c linkKey k d unless ((srv, sndId) `sameQAddress` qAddress (connReqQueue cReq)) $ throwE $ AGENT $ A_LINK "different address" pure r -delInvShortLink' :: AgentClient -> ConnShortLink 'CMInvitation -> AM () -delInvShortLink' = undefined +deleteLocalInvShortLink' :: AgentClient -> ConnShortLink 'CMInvitation -> AM () +deleteLocalInvShortLink' c (CSLInvitation srv linkId _) = withStore' c $ \db -> deleteInvShortLink db srv linkId changeConnectionUser' :: AgentClient -> UserId -> ConnId -> UserId -> AM () changeConnectionUser' c oldUserId connId newUserId = do @@ -849,13 +889,8 @@ changeConnectionUser' c oldUserId connId newUserId = do where updateConn = withStore' c $ \db -> setConnUserId db oldUserId connId newUserId -newRcvConnSrv :: ConnectionModeI c => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnectionRequestUri c) -newRcvConnSrv c userId connId enableNtfs cMode = - fmap fst .:: newRcvConnSrv_ c userId connId enableNtfs cMode Nothing -{-# INLINE newRcvConnSrv #-} - -newRcvConnSrv_ :: forall c. ConnectionModeI c => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnectionRequestUri c, Maybe (ConnShortLink c)) -newRcvConnSrv_ c userId connId enableNtfs cMode userData_ clientData pqInitKeys subMode srvWithAuth@(ProtoServerWithAuth srv _) = do +newRcvConnSrv :: forall c. ConnectionModeI c => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnectionRequestUri c, Maybe (ConnShortLink c)) +newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys subMode srvWithAuth@(ProtoServerWithAuth srv _) = do case (cMode, pqInitKeys) of (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv" _ -> pure () @@ -898,12 +933,12 @@ newRcvConnSrv_ c userId connId enableNtfs cMode userData_ clientData pqInitKeys g <- asks random nonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g - AgentConfig {smpClientVRange = vr, smpAgentVRange = agentVRange} <- asks config + AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config let sndId = SMP.EntityId $ C.sha3_256 corrId sndSecure = case cMode of SCMContact -> False; SCMInvitation -> True qUri = SMPQueueUri vr $ SMPQueueAddress srv sndId e2eDhKey sndSecure connReq <- createConnReq qUri - let (linkKey, linkData) = SL.encodeSignLinkData sigKeys agentVRange connReq userData + let (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq userData qd <- case cMode of SCMContact -> do let (linkId, k) = SL.contactShortLinkKdf linkKey @@ -956,8 +991,6 @@ newConnToAccept c connId enableNtfs invId pqSup = do newConnToJoin c userId connId enableNtfs connReq pqSup _ -> throwE $ CMD PROHIBITED "newConnToAccept" --- Short link MUST be passed again to joinConnection so that the same sender key is used. --- The alternative design would be to create connection ID and SndQueue when short link is read. joinConn :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured joinConn c userId connId enableNtfs cReq cInfo pqSupport subMode = do srv <- getNextSMPServer c userId [qServer $ connReqQueue cReq] @@ -968,7 +1001,7 @@ connReqQueue = \case CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q -startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448, Bool) +startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448, Maybe SMP.LinkId) startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = lift (compatibleInvitationUri cReqUri) >>= \case Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do @@ -986,15 +1019,17 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = Left e -> do nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e)) runExceptT $ createRatchet_ db g maxSupported pqSupport e2eRcvParams - pure (cData, sq, e2eSndParams, False) + pure (cData, sq, e2eSndParams, Nothing) _ -> do let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo - sndKeys_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId + invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId + let lnkId_ = fst <$> invLink_ + sndKeys_ = snd <$> invLink_ (q, _) <- lift $ newSndQueue userId "" qInfo sndKeys_ withStore c $ \db -> runExceptT $ do e2eSndParams <- createRatchet_ db g maxSupported pqSupport e2eRcvParams sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ - pure (cData, sq', e2eSndParams, isJust sndKeys_) + pure (cData, sq', e2eSndParams, lnkId_) Nothing -> throwE $ AGENT A_VERSION where createRatchet_ db g maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do @@ -1048,20 +1083,20 @@ joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMod where doJoin :: Maybe SndQueue -> AM SndQueueSecured doJoin sq_ = do - (cData, sq, e2eSndParams, hasLink) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup + (cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup secureConfirmQueue c cData sq srv cInfo (Just e2eSndParams) subMode - >>= (when hasLink (delInvSL c connId srv sq) $>) + >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) joinConnSrv c userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case Just (qInfo, vrsn) -> do - cReq <- newRcvConnSrv c userId connId enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv + (cReq, _) <- newRcvConnSrv c userId connId enableNtfs SCMInvitation Nothing Nothing (CR.IKNoPQ pqSup) subMode srv void $ sendInvitation c userId connId qInfo vrsn cReq cInfo pure False Nothing -> throwE $ AGENT A_VERSION -delInvSL :: AgentClient -> ConnId -> SMPServerWithAuth -> SndQueue -> AM () -delInvSL c connId srv sq = - withStore' c (\db -> deleteInvShortLink db (protoServer srv) (queueId sq)) `catchE` \e -> +delInvSL :: AgentClient -> ConnId -> SMPServerWithAuth -> SMP.LinkId -> AM () +delInvSL c connId srv lnkId = + withStore' c (\db -> deleteInvShortLink db (protoServer srv) lnkId) `catchE` \e -> liftIO $ nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "error deleting short link " <> show e)) joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured @@ -1074,9 +1109,9 @@ joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSuppo where doJoin :: Maybe SndQueue -> AM SndQueueSecured doJoin sq_ = do - (cData, sq, e2eSndParams, hasLink) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSupport + (cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSupport secureConfirmQueueAsync c cData sq srv cInfo (Just e2eSndParams) subMode - >>= (when hasLink (delInvSL c connId srv sq) $>) + >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _pqSupport _srv = do throwE $ CMD PROHIBITED "joinConnSrvAsync" @@ -1364,7 +1399,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do NEW enableNtfs (ACM cMode) pqEnc subMode -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do - cReq <- newRcvConnSrv c userId connId enableNtfs cMode Nothing pqEnc subMode srv + (cReq, _) <- newRcvConnSrv c userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv notify $ INV (ACR cMode cReq) JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index ae80dc459..0ea7e1e1a 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -1066,7 +1066,7 @@ withSMPClient c q cmdStr action = do sendOrProxySMPMessage :: AgentClient -> UserId -> SMPServer -> ConnId -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer) sendOrProxySMPMessage c userId destSrv connId cmdStr spKey_ senderId msgFlags msg = - sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendViaProxy sendDirectly + fst <$> sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendViaProxy sendDirectly where sendViaProxy smp proxySess = do atomically $ incSMPServerStat c userId destSrv sentViaProxyAttempts @@ -1077,20 +1077,6 @@ sendOrProxySMPMessage c userId destSrv connId cmdStr spKey_ senderId msgFlags ms sendSMPMessage smp spKey_ senderId msgFlags msg sendOrProxySMPCommand :: - AgentClient -> - UserId -> - SMPServer -> - ConnId -> - ByteString -> - SMP.SenderId -> - (SMPClient -> ProxiedRelay -> ExceptT SMPClientError IO (Either ProxyClientError ())) -> - (SMPClient -> ExceptT SMPClientError IO ()) -> - AM (Maybe SMPServer) -sendOrProxySMPCommand c userId destSrv connId cmdStr entId sendCmdViaProxy sendCmdDirectly = - fst <$> sendOrProxySMPCommand_ c userId destSrv connId cmdStr entId sendCmdViaProxy sendCmdDirectly -{-# INLINE sendOrProxySMPCommand #-} - -sendOrProxySMPCommand_ :: forall a. AgentClient -> UserId -> @@ -1101,7 +1087,7 @@ sendOrProxySMPCommand_ :: (SMPClient -> ProxiedRelay -> ExceptT SMPClientError IO (Either ProxyClientError a)) -> (SMPClient -> ExceptT SMPClientError IO a) -> AM (Maybe SMPServer, a) -sendOrProxySMPCommand_ c userId destSrv@ProtocolServer {host = destHosts} connId cmdStr entId sendCmdViaProxy sendCmdDirectly = do +sendOrProxySMPCommand c userId destSrv@ProtocolServer {host = destHosts} connId cmdStr entId sendCmdViaProxy sendCmdDirectly = do tSess <- mkTransportSession c userId destSrv connId ifM shouldUseProxy (sendViaProxy Nothing tSess) ((Nothing,) <$> sendDirectly tSess) where @@ -1698,14 +1684,14 @@ deleteQueueLink c rq@RcvQueue {rcvId, rcvPrivateKey} = secureGetQueueLink :: AgentClient -> UserId -> InvShortLink -> AM (SMP.SenderId, QueueLinkData) secureGetQueueLink c userId InvShortLink {server, linkId, sndPrivateKey, sndPublicKey} = - snd <$> sendOrProxySMPCommand_ c userId server (unEntityId linkId) "LKEY " linkId secureGetViaProxy secureGetDirectly + snd <$> sendOrProxySMPCommand c userId server (unEntityId linkId) "LKEY " linkId secureGetViaProxy secureGetDirectly where secureGetViaProxy smp proxySess = proxySecureGetSMPQueueLink smp proxySess sndPrivateKey linkId sndPublicKey secureGetDirectly smp = secureGetSMPQueueLink smp sndPrivateKey linkId sndPublicKey getQueueLink :: AgentClient -> UserId -> SMPServer -> SMP.LinkId -> AM (SMP.SenderId, QueueLinkData) getQueueLink c userId server lnkId = - snd <$> sendOrProxySMPCommand_ c userId server (unEntityId lnkId) "LGET" lnkId getViaProxy getDirectly + snd <$> sendOrProxySMPCommand c userId server (unEntityId lnkId) "LGET" lnkId getViaProxy getDirectly where getViaProxy smp proxySess = proxyGetSMPQueueLink smp proxySess lnkId getDirectly smp = getSMPQueueLink smp lnkId diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index 9548b296c..3b7f69d14 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -94,6 +94,7 @@ module Simplex.Messaging.Agent.Store.AgentStore deleteInvShortLink, createInvShortLink, setInvShortLinkSndId, + updateShortLinkCreds, -- Messages updateRcvIds, createRcvMsg, @@ -782,24 +783,24 @@ getInvShortLink db server linkId = let sndPublicKey = C.APublicAuthKey a $ C.publicKey pk in InvShortLink {server, linkId, linkKey, sndPrivateKey, sndPublicKey, sndId} -getInvShortLinkKeys :: DB.Connection -> SMPServer -> SenderId -> IO (Maybe C.AAuthKeyPair) +getInvShortLinkKeys :: DB.Connection -> SMPServer -> SenderId -> IO (Maybe (LinkId, C.AAuthKeyPair)) getInvShortLinkKeys db srv sndId = maybeFirstRow toSndKeys $ DB.query db [sql| - SELECT snd_private_key + SELECT link_id, snd_private_key FROM inv_short_links WHERE host = ? AND port = ? AND snd_id = ? |] (host srv, port srv, sndId) where - toSndKeys :: Only C.APrivateAuthKey -> C.AAuthKeyPair - toSndKeys (Only privKey@(C.APrivateAuthKey a pk)) = (C.APublicAuthKey a $ C.publicKey pk, privKey) + toSndKeys :: (LinkId, C.APrivateAuthKey) -> (LinkId, C.AAuthKeyPair) + toSndKeys (linkId, privKey@(C.APrivateAuthKey a pk)) = (linkId, (C.APublicAuthKey a $ C.publicKey pk, privKey)) -deleteInvShortLink :: DB.Connection -> SMPServer -> SenderId -> IO () -deleteInvShortLink db srv sndId = - DB.execute db "DELETE FROM inv_short_links WHERE host = ? AND port = ? AND snd_id = ?" (host srv, port srv, sndId) +deleteInvShortLink :: DB.Connection -> SMPServer -> LinkId -> IO () +deleteInvShortLink db srv lnkId = + DB.execute db "DELETE FROM inv_short_links WHERE host = ? AND port = ? AND link_id = ?" (host srv, port srv, lnkId) createInvShortLink :: DB.Connection -> InvShortLink -> IO () createInvShortLink db InvShortLink {server, linkId, linkKey, sndPrivateKey, sndId} = do @@ -830,6 +831,17 @@ setInvShortLinkSndId db InvShortLink {server, linkId} sndId = |] (sndId, host server, port server, linkId) +updateShortLinkCreds :: DB.Connection -> RcvQueue -> ShortLinkCreds -> IO () +updateShortLinkCreds db RcvQueue {server, rcvId} ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} = + DB.execute + db + [sql| + UPDATE rcv_queues + SET link_id = ?, link_key = ?, link_priv_sig_key = ?, link_enc_fixed_data = ? + WHERE host = ? AND port = ? AND rcv_id = ? + |] + (shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData, host server, port server, rcvId) + updateRcvIds :: DB.Connection -> ConnId -> IO (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash) updateRcvIds db connId = do (lastInternalId, lastInternalRcvId, lastExternalSndId, lastRcvHash) <- retrieveLastIdsAndHashRcv_ db connId diff --git a/src/Simplex/Messaging/Crypto/ShortLink.hs b/src/Simplex/Messaging/Crypto/ShortLink.hs index 786d89ec8..b617196d4 100644 --- a/src/Simplex/Messaging/Crypto/ShortLink.hs +++ b/src/Simplex/Messaging/Crypto/ShortLink.hs @@ -31,17 +31,25 @@ encodeSignLinkData :: ConnectionModeI c => C.KeyPair 'C.Ed25519 -> VersionRangeS encodeSignLinkData (sigKey, pk) agentVRange connReq userData = let fd = smpEncode FixedLinkData {agentVRange, sigKey, connReq} ud = smpEncode UserLinkData {agentVRange, userData} - in (LinkKey (C.sha3_256 fd), (sign fd, sign ud)) - where - sign s = smpEncode (C.signatureBytes $ C.sign' pk s) <> s + in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk ud)) + +encodeSignUserData :: C.PrivateKeyEd25519 -> VersionRangeSMPA -> ConnInfo -> ByteString +encodeSignUserData pk agentVRange userData = + encodeSign pk $ smpEncode UserLinkData {agentVRange, userData} + +encodeSign :: C.PrivateKeyEd25519 -> ByteString -> ByteString +encodeSign pk s = smpEncode (C.signatureBytes $ C.sign' pk s) <> s -- TODO [short links] possibly use padded encryption for fixed and for user data encryptLinkData :: TVar ChaChaDRG -> C.SbKey -> (ByteString, ByteString) -> IO QueueLinkData encryptLinkData g k = bimapM encrypt encrypt where - encrypt s = do - nonce <- atomically $ C.randomCbNonce g - pure $ EncDataBytes $ smpEncode nonce <> C.sbEncryptNoPad k nonce s + encrypt = encryptData g k + +encryptData :: TVar ChaChaDRG -> C.SbKey -> ByteString -> IO EncDataBytes +encryptData g k s = do + nonce <- atomically $ C.randomCbNonce g + pure $ EncDataBytes $ smpEncode nonce <> C.sbEncryptNoPad k nonce s decryptLinkData :: ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (ConnectionRequestUri c, ConnInfo) decryptLinkData linkKey k (encFD, encUD) = do diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 1aa6b0d64..cebcb4735 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -1264,11 +1264,13 @@ client ACK msgId -> withQueue $ acknowledgeMsg msgId KEY sKey -> withQueue $ \q _ -> (corrId,entId,) . either ERR id <$> secureQueue_ q sKey LSET lnkId d -> - withQueue $ \q qr -> checkMode QMContact qr $ liftIO $ - OK <$$ addQueueLinkData (queueStore ms) q lnkId d + withQueue $ \q qr -> checkMode QMContact qr $ liftIO $ case queueData qr of + Just (lnkId', _) | lnkId' /= lnkId -> pure $ Left AUTH + _ -> OK <$$ addQueueLinkData (queueStore ms) q lnkId d LDEL -> - withQueue $ \q _ -> liftIO $ (corrId,entId,) . either ERR (const OK) <$> - deleteQueueLinkData (queueStore ms) q + withQueue $ \q qr -> checkMode QMContact qr $ liftIO $ case queueData qr of + Just _ -> OK <$$ deleteQueueLinkData (queueStore ms) q + Nothing -> pure $ Right OK NKEY nKey dhKey -> withQueue $ \q _ -> addQueueNotifier_ q nKey dhKey NDEL -> withQueue $ \q _ -> deleteQueueNotifier_ q OFF -> maybe (pure $ err INTERNAL) suspendQueue_ q_ diff --git a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs index 5de63d367..6aca44640 100644 --- a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs +++ b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs @@ -219,7 +219,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where Nothing -> addLink q $ \db -> DB.execute db qry (d :. (lnkId, rId)) Just (lnkId', _) | lnkId' == lnkId -> - addLink q $ \db -> DB.execute db (qry <> " AND (fixed_data IS NULL OR fixed_data != ?)") (d :. (lnkId, rId, fst d)) + addLink q $ \db -> DB.execute db (qry <> " AND (fixed_data IS NULL OR fixed_data = ?)") (d :. (lnkId, rId, fst d)) _ -> throwE AUTH where rId = recipientId sq diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 63e6e3f49..35301c687 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -312,6 +312,7 @@ functionalAPITests ps = do it "should connect via 1-time short link" $ testInviationShortLink ps it "should connect via 1-time short link with async join" $ testInviationShortLinkAsync ps it "should connect via contact short link" $ testContactShortLink ps + it "should add short link to existing contact and connect" $ testAddContactShortLink ps describe "Message delivery" $ do describe "update connection agent version on received messages" $ do it "should increase if compatible, shouldn'ps decrease" $ @@ -1130,7 +1131,7 @@ testContactShortLink :: HasCallStack => (ATransport, AStoreType) -> IO () testContactShortLink ps = withAgentClients3 $ \a b c -> withSmpServer ps $ do let userData = "some user data" - (_contactId, (connReq, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe + (contactId, (connReq, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq @@ -1156,6 +1157,59 @@ testContactShortLink ps = get a ##> ("", bId, CON) get b ##> ("", aId, CON) exchangeGreetings a bId b aId + -- update user data + let updatedData = "updated user data" + shortLink' <- runRight $ setContactShortLink a contactId updatedData + shortLink' `shouldBe` shortLink + (connReq4, updatedData') <- runRight $ getConnShortLink c 1 shortLink + connReq4 `shouldBe` connReq + updatedData' `shouldBe` updatedData + -- one more time + shortLink2 <- runRight $ setContactShortLink a contactId updatedData + shortLink2 `shouldBe` shortLink + -- delete short link + runRight_ $ deleteContactShortLink a contactId + Left (SMP _ AUTH) <- runExceptT $ getConnShortLink c 1 shortLink + pure () + +testAddContactShortLink :: HasCallStack => (ATransport, AStoreType) -> IO () +testAddContactShortLink ps = + withAgentClients3 $ \a b c -> withSmpServer ps $ do + (contactId, (connReq, Nothing)) <- runRight $ A.createConnection a 1 True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe + let userData = "some user data" + shortLink <- runRight $ setContactShortLink a contactId userData + (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink + strDecode (strEncode shortLink) `shouldBe` Right shortLink + connReq' `shouldBe` connReq + userData' `shouldBe` userData + -- same user can get contact link again + (connReq2, userData2) <- runRight $ getConnShortLink b 1 shortLink + connReq2 `shouldBe` connReq + userData2 `shouldBe` userData + -- another user can get the same contact link + (connReq3, userData3) <- runRight $ getConnShortLink c 1 shortLink + connReq3 `shouldBe` connReq + userData3 `shouldBe` userData + runRight $ do + (aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe + liftIO $ sndSecure `shouldBe` False + ("", _, REQ invId _ "bob's connInfo") <- get a + bId <- A.prepareConnectionToAccept a True invId PQSupportOn + sndSecure' <- acceptContact a bId True invId "alice's connInfo" PQSupportOn SMSubscribe + liftIO $ sndSecure' `shouldBe` True + ("", _, CONF confId _ "alice's connInfo") <- get b + allowConnection b aId confId "bob's connInfo" + get a ##> ("", bId, INFO "bob's connInfo") + get a ##> ("", bId, CON) + get b ##> ("", aId, CON) + exchangeGreetings a bId b aId + -- update user data + let updatedData = "updated user data" + shortLink' <- runRight $ setContactShortLink a contactId updatedData + shortLink' `shouldBe` shortLink + (connReq4, updatedData') <- runRight $ getConnShortLink c 1 shortLink + connReq4 `shouldBe` connReq + updatedData' `shouldBe` updatedData testIncreaseConnAgentVersion :: HasCallStack => (ATransport, AStoreType) -> IO () testIncreaseConnAgentVersion ps = do diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 8fd798a6b..b52057b7c 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -1102,6 +1102,13 @@ testInvQueueLinkData = sId3 `shouldBe` sId ld2 `shouldBe` ld + let newLD = (EncDataBytes "fixed data", EncDataBytes "updated user data") + Resp "8" rId' (ERR AUTH) <- signSendRecv r rKey ("8", rId, LSET lnkId newLD) + rId' `shouldBe` rId + + Resp "9" rId2 (ERR AUTH) <- signSendRecv r rKey ("9", rId, LDEL) + rId2 `shouldBe` rId + testContactQueueLinkData :: SpecWith (ATransport, AStoreType) testContactQueueLinkData = it "create and access queue short link data for contact address" $ \(ATransport t, msType) -> @@ -1141,6 +1148,27 @@ testContactQueueLinkData = sId3 `shouldBe` sId ld2 `shouldBe` ld + let newLD = (EncDataBytes "fixed data", EncDataBytes "updated user data") + Resp "7" rId' OK <- signSendRecv r rKey ("7", rId, LSET lnkId newLD) + rId' `shouldBe` rId + + Resp "8" _ (LNK sId4 ld3) <- sendRecv s ("", "8", lnkId, LGET) + sId4 `shouldBe` sId + ld3 `shouldBe` newLD + + badLnkId <- EntityId <$> atomically (C.randomBytes 24 g) + Resp "9" _ (ERR AUTH) <- signSendRecv r rKey ("9", rId, LSET badLnkId newLD) + + let badLD = (EncDataBytes "changed fixed data", EncDataBytes "updated user data 2") + Resp "10" _ (ERR AUTH) <- signSendRecv r rKey ("10", rId, LSET lnkId badLD) + + Resp "11" rId2 OK <- signSendRecv r rKey ("11", rId, LDEL) + rId2 `shouldBe` rId + Resp "11a" _ OK <- signSendRecv r rKey ("11a", rId, LDEL) + + Resp "12" lnkId3 (ERR AUTH) <- sendRecv s ("", "12", lnkId, LGET) + lnkId3 `shouldBe` lnkId + samplePubKey :: C.APublicVerifyKey samplePubKey = C.APublicVerifyKey C.SEd25519 "MCowBQYDK2VwAyEAfAOflyvbJv1fszgzkQ6buiZJVgSpQWsucXq7U6zjMgY="