From 3e5b65410920249301395ae2cf29bea121689da3 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Mon, 19 Jan 2026 22:08:11 +0000 Subject: [PATCH 1/3] agent: support multiple link owners in link data (#1701) * agent: support multiple link owners in link data * fix --- src/Simplex/Messaging/Agent.hs | 13 +- src/Simplex/Messaging/Agent/Client.hs | 4 +- src/Simplex/Messaging/Agent/Protocol.hs | 84 ++++++++---- src/Simplex/Messaging/Agent/Store.hs | 8 -- .../Messaging/Agent/Store/AgentStore.hs | 2 +- .../Messaging/Agent/Store/Postgres/Common.hs | 3 +- src/Simplex/Messaging/Crypto/ShortLink.hs | 13 +- tests/AgentTests/EqInstances.hs | 2 +- tests/AgentTests/FunctionalAPITests.hs | 2 +- tests/AgentTests/ShortLinkTests.hs | 120 +++++++++++++++++- 10 files changed, 204 insertions(+), 47 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index f8312824e..f81add594 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -897,10 +897,12 @@ setConnShortLinkAsync' c corrId connId cMode userLinkData clientData = withConnLock c connId "setConnShortLinkAsync" $ do SomeConn _ conn <- withStore c (`getConn` connId) srv <- case (conn, cMode, userLinkData) of - (ContactConnection _ RcvQueue {server}, SCMContact, UserContactLinkData {}) -> pure server + (ContactConnection _ RcvQueue {server, shortLink}, SCMContact, UserContactLinkData d) -> do + liftEitherWith (CMD PROHIBITED . ("setConnShortLinkAsync: " <> )) $ validateOwners shortLink d + pure server (RcvConnection _ RcvQueue {server}, SCMInvitation, UserInvLinkData {}) -> pure server _ -> throwE $ CMD PROHIBITED "setConnShortLinkAsync: invalid connection or mode" - enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET (AUCLD cMode userLinkData) clientData + enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET (AULD cMode userLinkData) clientData setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM (ConnShortLink c) setConnShortLink' c nm connId cMode userLinkData clientData = @@ -914,7 +916,8 @@ setConnShortLink' c nm connId cMode userLinkData clientData = pure sl where prepareContactLinkData :: RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData) - prepareContactLinkData rq@RcvQueue {shortLink} ud = do + prepareContactLinkData rq@RcvQueue {shortLink} ud@(UserContactLinkData d') = do + liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <> )) $ validateOwners shortLink d' g <- asks random AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config let cslContact = CSLContact SLSServer CCTContact (qServer rq) @@ -931,7 +934,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData = (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq ud (linkId, k) = SL.contactShortLinkKdf linkKey srvData <- liftError id $ SL.encryptLinkData g k linkData - let slCreds = ShortLinkCreds linkId linkKey privSigKey (fst srvData) + let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing (fst srvData) withStore' c $ \db -> updateShortLinkCreds db rq slCreds pure (rq, linkId, cslContact linkKey, srvData) prepareInvLinkData :: RcvQueue -> UserConnLinkData 'CMInvitation -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData) @@ -1676,7 +1679,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do (CCLink cReq _, service) <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv notify $ INV (ACR cMode cReq) service - LSET auData@(AUCLD cMode userLinkData) clientData -> + LSET auData@(AULD cMode userLinkData) clientData -> withServer' . tryCommand $ do link <- setConnShortLink' c NRMBackground connId cMode userLinkData clientData notify $ LINK (ACSL cMode link) auData diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index ebc5410d1..00a228330 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -1448,12 +1448,12 @@ newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enabl (CQRMessaging ld, Just QMMessaging) -> withLinkData ld $ \lnkId CQRData {linkKey, privSigKey, srvReq = (sndId', d)} -> if sndId == sndId' - then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey (fst d) + then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey Nothing (fst d) else newErr "different sender ID" (CQRContact ld, Just QMContact) -> withLinkData ld $ \lnkId CQRData {linkKey, privSigKey, srvReq = (lnkId', (sndId', d))} -> if sndId == sndId' && lnkId == lnkId' - then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey (fst d) + then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey Nothing (fst d) else newErr "different sender or link IDs" (_, Nothing) -> case linkId of Nothing | v < sndAuthKeySMPVersion -> pure Nothing diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index fb9f1d46b..cf511482f 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -107,6 +107,7 @@ module Simplex.Messaging.Agent.Protocol ConnectionModeI (..), ConnectionRequestUri (..), AConnectionRequestUri (..), + ShortLinkCreds (..), ConnReqUriData (..), CRClientData, ServiceScheme, @@ -130,6 +131,8 @@ module Simplex.Messaging.Agent.Protocol StoredClientService (..), ClientService, ClientServiceId, + validateOwners, + validateLinkOwners, sameConnReqContact, sameShortLinkContact, simplexChat, @@ -198,7 +201,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1, encodeUtf8) @@ -1439,6 +1442,15 @@ instance Eq AConnectionRequestUri where deriving instance Show AConnectionRequestUri +data ShortLinkCreds = ShortLinkCreds + { shortLinkId :: SMP.LinkId, + shortLinkKey :: LinkKey, + linkPrivSigKey :: C.PrivateKeyEd25519, + linkRootSigKey :: Maybe C.PublicKeyEd25519, -- in case the current user is not the original owner, and the root key is different from linkPrivSigKey + linkEncFixedData :: SMP.EncFixedDataBytes + } + deriving (Show) + data ShortLinkScheme = SLSSimplex | SLSServer deriving (Eq, Show) data ConnShortLink (m :: ConnectionMode) where @@ -1694,7 +1706,8 @@ type CRClientData = Text data FixedLinkData c = FixedLinkData { agentVRange :: VersionRangeSMPA, rootKey :: C.PublicKeyEd25519, - connReq :: ConnectionRequestUri c + connReq :: ConnectionRequestUri c, + linkEntityId :: Maybe ByteString } data ConnLinkData c where @@ -1725,10 +1738,10 @@ deriving instance Eq (UserConnLinkData m) deriving instance Show (UserConnLinkData m) -data AUserConnLinkData = forall m. ConnectionModeI m => AUCLD (SConnectionMode m) (UserConnLinkData m) +data AUserConnLinkData = forall m. ConnectionModeI m => AULD (SConnectionMode m) (UserConnLinkData m) instance Eq AUserConnLinkData where - AUCLD m d == AUCLD m' d' = case testEquality m m' of + AULD m d == AULD m' d' = case testEquality m m' of Just Refl -> d == d' Nothing -> False @@ -1749,32 +1762,55 @@ type OwnerId = ByteString data OwnerAuth = OwnerAuth { ownerId :: OwnerId, -- unique in the list, application specific - e.g., MemberId ownerKey :: C.PublicKeyEd25519, - -- sender ID signed with ownerKey, - -- confirms that the owner accepts being the owner. - -- sender ID is used here as it is immutable for the queue, link data can be removed. - ownerSig :: C.Signature 'C.Ed25519, - -- null for root key authorization - authOwnerId :: OwnerId, - -- owner authorization, sig(ownerId || ownerKey, key(authOwnerId)), - -- where authOwnerId is either null for a root key or some other owner authorized by root key, etc. - -- Owner validation should detect and reject loops. + -- owner authorization by root or any previous owner, sig(ownerId || ownerKey, prevOwnerKey), authOwnerSig :: C.Signature 'C.Ed25519 } deriving (Eq, Show) instance Encoding OwnerAuth where - smpEncode OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig} = - smpEncode (ownerId, ownerKey, C.signatureBytes ownerSig, authOwnerId, C.signatureBytes authOwnerSig) + smpEncode OwnerAuth {ownerId, ownerKey, authOwnerSig} = + -- It is additionally encoded as ByteString to have known length and allow OwnerAuth extension + smpEncode $ smpEncode (ownerId, ownerKey, C.signatureBytes authOwnerSig) smpP = do - (ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig) <- smpP - pure OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig} + -- parseOnly ignores any unused extension + (ownerId, ownerKey, authOwnerSig) <- A.parseOnly smpP <$?> smpP + pure OwnerAuth {ownerId, ownerKey, authOwnerSig} + +validateOwners :: Maybe ShortLinkCreds -> UserContactData -> Either String () +validateOwners shortLink_ UserContactData {owners} = case shortLink_ of + Nothing + | null owners -> Right () + | otherwise -> Left "no link credentials with additional owners" + Just ShortLinkCreds {linkPrivSigKey, linkRootSigKey} + | hasOwner -> validateLinkOwners (fromMaybe k linkRootSigKey) owners + | otherwise -> Left "no current owner in link data" + where + hasOwner = isNothing linkRootSigKey || any ((k ==) . ownerKey) owners + k = C.publicKey linkPrivSigKey + +validateLinkOwners :: C.PublicKeyEd25519 -> [OwnerAuth] -> Either String () +validateLinkOwners rootKey = go [] + where + go _ [] = Right () + go prev (o : os) = validOwner o >> go (o : prev) os + where + validOwner OwnerAuth {ownerId = oId, ownerKey = k, authOwnerSig = sig} + | k == rootKey = Left $ "owner key for ID " <> idStr <> " matches root key" + | any duplicate prev = Left $ "duplicate owner key or ID " <> idStr + | signedBy rootKey || any (signedBy . ownerKey) prev = Right () + | otherwise = Left $ "invalid authorization of owner ID " <> idStr + where + duplicate OwnerAuth {ownerId, ownerKey} = oId == ownerId || k == ownerKey + idStr = B.unpack $ B64.encodeUnpadded oId + signedBy k' = C.verify' k' sig (oId <> C.encodePubKey k) instance ConnectionModeI c => Encoding (FixedLinkData c) where - smpEncode FixedLinkData {agentVRange, rootKey, connReq} = - smpEncode (agentVRange, rootKey, connReq) + smpEncode FixedLinkData {agentVRange, rootKey, connReq, linkEntityId} = + smpEncode (agentVRange, rootKey, connReq) <> maybe "" smpEncode linkEntityId smpP = do (agentVRange, rootKey, connReq) <- smpP - pure FixedLinkData {agentVRange, rootKey, connReq} + linkEntityId <- (smpP <|> pure Nothing) <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding + pure FixedLinkData {agentVRange, rootKey, connReq, linkEntityId} instance ConnectionModeI c => Encoding (ConnLinkData c) where smpEncode = \case @@ -1799,19 +1835,19 @@ instance ConnectionModeI c => Encoding (UserConnLinkData c) where smpEncode = \case UserInvLinkData userData -> smpEncode (CMInvitation, userData) UserContactLinkData cd -> smpEncode (CMContact, cd) - smpP = (\(AUCLD _ d) -> checkConnMode d) <$?> smpP + smpP = (\(AULD _ d) -> checkConnMode d) <$?> smpP {-# INLINE smpP #-} instance Encoding AUserConnLinkData where - smpEncode (AUCLD _ d) = smpEncode d + smpEncode (AULD _ d) = smpEncode d {-# INLINE smpEncode #-} smpP = smpP >>= \case CMInvitation -> do userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding - pure $ AUCLD SCMInvitation $ UserInvLinkData userData + pure $ AULD SCMInvitation $ UserInvLinkData userData CMContact -> - AUCLD SCMContact . UserContactLinkData <$> smpP + AULD SCMContact . UserContactLinkData <$> smpP instance StrEncoding AUserConnLinkData where strEncode = smpEncode diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 25ad86729..5f4a4aaa1 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -127,14 +127,6 @@ rcvQueueSub :: RcvQueue -> RcvQueueSub rcvQueueSub RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId = DBEntityId dbQueueId, primary, dbReplaceQueueId} = RcvQueueSub {userId, connId, server, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId, primary, dbReplaceQueueId} -data ShortLinkCreds = ShortLinkCreds - { shortLinkId :: SMP.LinkId, - shortLinkKey :: LinkKey, - linkPrivSigKey :: C.PrivateKeyEd25519, - linkEncFixedData :: SMP.EncFixedDataBytes - } - deriving (Show) - clientServiceId :: RcvQueue -> Maybe ClientServiceId clientServiceId = fmap dbServiceId . clientService {-# INLINE clientServiceId #-} diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index fb8d8a166..ce6e71a5e 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -2491,7 +2491,7 @@ toRcvQueue (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret) -> Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret} _ -> Nothing shortLink = case (shortLinkId_, shortLinkKey_, linkPrivSigKey_, linkEncFixedData_) of - (Just shortLinkId, Just shortLinkKey, Just linkPrivSigKey, Just linkEncFixedData) -> Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} + (Just shortLinkId, Just shortLinkKey, Just linkPrivSigKey, Just linkEncFixedData) -> Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkRootSigKey = Nothing, linkEncFixedData} -- TODO linkRootSigKey should be stored in a separate field _ -> Nothing enableNtfs = maybe True unBI enableNtfs_ -- TODO [certs rcv] read client service diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Common.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Common.hs index d9214131b..b38b7ecbd 100644 --- a/src/Simplex/Messaging/Agent/Store/Postgres/Common.hs +++ b/src/Simplex/Messaging/Agent/Store/Postgres/Common.hs @@ -19,6 +19,7 @@ module Simplex.Messaging.Agent.Store.Postgres.Common ) where +import Control.Monad (void) import Control.Concurrent.MVar import Control.Concurrent.STM import qualified Control.Exception as E @@ -100,7 +101,7 @@ withTransactionPriority st priority action = withConnectionPriority st priority -- to restore the transaction to a usable state before returning the error. withSavepoint :: PSQL.Connection -> PSQL.Query -> IO a -> IO (Either PSQL.SqlError a) withSavepoint db name action = do - PSQL.execute_ db $ "SAVEPOINT " <> name + void $ PSQL.execute_ db $ "SAVEPOINT " <> name E.try action >>= bimapM (PSQL.execute_ db ("ROLLBACK TO SAVEPOINT " <> name) $>) diff --git a/src/Simplex/Messaging/Crypto/ShortLink.hs b/src/Simplex/Messaging/Crypto/ShortLink.hs index f7c65c1e6..962c1aecc 100644 --- a/src/Simplex/Messaging/Crypto/ShortLink.hs +++ b/src/Simplex/Messaging/Crypto/ShortLink.hs @@ -21,6 +21,7 @@ module Simplex.Messaging.Crypto.ShortLink where import Control.Concurrent.STM +import Control.Monad (unless) import Control.Monad.Except import Control.Monad.IO.Class import Crypto.Random (ChaChaDRG) @@ -51,7 +52,7 @@ invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32 encodeSignLinkData :: ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> UserConnLinkData c -> (LinkKey, (ByteString, ByteString)) encodeSignLinkData (rootKey, pk) agentVRange connReq userData = - let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq} + let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq, linkEntityId = Nothing} md = smpEncode $ connLinkData agentVRange userData in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk md)) @@ -87,11 +88,16 @@ decryptLinkData linkKey k (encFD, encMD) = do (sig2, md) <- decrypt encMD FixedLinkData {rootKey, connReq} <- decode fd md' <- decode @(ConnLinkData c) md + let signedBy k' = C.verify' k' sig2 md if | LinkKey (C.sha3_256 fd) /= linkKey -> linkErr "link data hash" | not (C.verify' rootKey sig1 fd) -> linkErr "link data signature" - | not (C.verify' rootKey sig2 md) -> linkErr "user data signature" - | otherwise -> Right (connReq, md') + | otherwise -> case md' of + InvitationLinkData {} -> unless (signedBy rootKey) $ linkErr "user data signature" + ContactLinkData _ UserContactData {owners} -> do + first (AGENT . A_LINK) $ validateLinkOwners rootKey owners + unless (signedBy rootKey || any (signedBy . ownerKey) owners) $ linkErr "user data signature" + Right (connReq, md') where decrypt (EncDataBytes d) = do (nonce, Tail ct) <- decode d @@ -100,4 +106,5 @@ decryptLinkData linkKey k (encFD, encMD) = do decode :: Encoding a => ByteString -> Either AgentErrorType a decode = msgErr . smpDecode msgErr = first (const $ AGENT A_MESSAGE) + linkErr :: String -> Either AgentErrorType () linkErr = Left . AGENT . A_LINK diff --git a/tests/AgentTests/EqInstances.hs b/tests/AgentTests/EqInstances.hs index 817580723..b33980f6a 100644 --- a/tests/AgentTests/EqInstances.hs +++ b/tests/AgentTests/EqInstances.hs @@ -5,7 +5,7 @@ module AgentTests.EqInstances where import Data.Type.Equality -import Simplex.Messaging.Agent.Protocol (ConnLinkData (..)) +import Simplex.Messaging.Agent.Protocol (ConnLinkData (..), ShortLinkCreds (..)) import Simplex.Messaging.Agent.Store import Simplex.Messaging.Client (ProxiedRelay (..)) diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 51d9a8adf..09c873d31 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -2676,7 +2676,7 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> let updatedData = UserLinkData "updated user data" updatedCtData = UserContactData {direct = False, owners = [], relays = [], userData = updatedData} setConnShortLinkAsync alice "1" cId SCMContact (UserContactLinkData updatedCtData) Nothing - ("1", cId', LINK (ACSL SCMContact shortLink') (AUCLD SCMContact (UserContactLinkData updatedCtData'))) <- get alice + ("1", cId', LINK (ACSL SCMContact shortLink') (AULD SCMContact (UserContactLinkData updatedCtData'))) <- get alice liftIO $ cId' `shouldBe` cId liftIO $ shortLink' `shouldBe` shortLink liftIO $ updatedCtData' `shouldBe` updatedCtData diff --git a/tests/AgentTests/ShortLinkTests.hs b/tests/AgentTests/ShortLinkTests.hs index 9a56cc655..ab6062c30 100644 --- a/tests/AgentTests/ShortLinkTests.hs +++ b/tests/AgentTests/ShortLinkTests.hs @@ -11,10 +11,14 @@ import AgentTests.ConnectionRequestTests (contactConnRequest, invConnRequest) import AgentTests.EqInstances () import Control.Concurrent.STM import Control.Monad.Except +import Crypto.Random (ChaChaDRG) +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Base64.URL as B64 import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), ConnLinkData (..), ConnectionMode (..), ConnShortLink (..), LinkKey (..), UserConnLinkData (..), SConnectionMode (..), SMPAgentError (..), UserContactData (..), UserLinkData (..), linkUserData, supportedSMPAgentVRange) +import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Crypto as C import qualified Simplex.Messaging.Crypto.ShortLink as SL +import Simplex.Messaging.Protocol (EncFixedDataBytes) import Test.Hspec hiding (fit, it) import Util @@ -28,6 +32,10 @@ shortLinkTests = do it "should encrypt updated user data" testUpdateContactShortLink it "should fail to decrypt contact data with bad hash" testContactShortLinkBadDataHash it "should fail to decrypt contact data with bad signature" testContactShortLinkBadSignature + describe "contact link with additional owners" $ do + it "should encrypt and decrypt data with additional owner" testContactShortLinkOwner + it "should encrypt and decrypt data with many additional owners" testContactShortLinkManyOwners + it "should fail to decrypt contact data with invalid or unauthorized owners" testContactShortLinkInvalidOwners testInvShortLink :: IO () testInvShortLink = do @@ -140,3 +148,113 @@ testContactShortLinkBadSignature = do -- decryption fails SL.decryptLinkData @'CMContact linkKey k (fd, ud') `shouldBe` Left (AGENT (A_LINK "user data signature")) + +testContactShortLinkOwner :: IO () +testContactShortLinkOwner = do + -- encrypt + g <- C.newRandom + (pk, lnk) <- encryptLink g + -- encrypt updated user data + (ownerPK, owner) <- authNewOwner g pk + let ud = UserContactData {direct = True, owners = [owner], relays = [], userData = UserLinkData "updated user data"} + testEncDec g pk lnk ud + testEncDec g ownerPK lnk ud + (_, wrongKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g + testEncDecFail g wrongKey lnk ud $ A_LINK "user data signature" + +encryptLink :: TVar ChaChaDRG -> IO (C.PrivateKeyEd25519, (EncFixedDataBytes, LinkKey, C.SbKey)) +encryptLink g = do + sigKeys@(_, pk) <- atomically $ C.generateKeyPair @'C.Ed25519 g + let userData = UserLinkData "some user data" + userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData} + (linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userLinkData + (_linkId, k) = SL.contactShortLinkKdf linkKey + Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData + pure (pk, (fd, linkKey, k)) + +authNewOwner :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> IO (C.PrivateKeyEd25519, OwnerAuth) +authNewOwner g pk = do + (ownerKey, ownerPK) <- atomically $ C.generateKeyPair @'C.Ed25519 g + ownerId <- atomically $ C.randomBytes 16 g + let authOwnerSig = C.sign' pk $ ownerId <> C.encodePubKey ownerKey + pure (ownerPK, OwnerAuth {ownerId, ownerKey, authOwnerSig}) + +testEncDec :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> (EncFixedDataBytes, LinkKey, C.SbKey) -> UserContactData -> IO () +testEncDec g pk (fd, linkKey, k) ctData = do + let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange $ UserContactLinkData ctData + Right ud <- runExceptT $ SL.encryptUserData g k signed + Right (connReq', ContactLinkData _ ctData') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud) + connReq' `shouldBe` contactConnRequest + ctData' `shouldBe` ctData + +testContactShortLinkManyOwners :: IO () +testContactShortLinkManyOwners = do + -- encrypt + g <- C.newRandom + (pk, lnk) <- encryptLink g + -- encrypt updated user data + (ownerPK1, owner1) <- authNewOwner g pk + (ownerPK2, owner2) <- authNewOwner g pk + (ownerPK3, owner3) <- authNewOwner g ownerPK1 + (ownerPK4, owner4) <- authNewOwner g ownerPK1 + (ownerPK5, owner5) <- authNewOwner g ownerPK3 + let owners = [owner1, owner2, owner3, owner4, owner5] + ud = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data"} + testEncDec g pk lnk ud + testEncDec g ownerPK1 lnk ud + testEncDec g ownerPK2 lnk ud + testEncDec g ownerPK3 lnk ud + testEncDec g ownerPK4 lnk ud + testEncDec g ownerPK5 lnk ud + (_, wrongKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g + testEncDecFail g wrongKey lnk ud $ A_LINK "user data signature" + +testContactShortLinkInvalidOwners :: IO () +testContactShortLinkInvalidOwners = do + -- encrypt + g <- C.newRandom + (pk, lnk) <- encryptLink g + -- encrypt updated user data + (ownerPK, owner) <- authNewOwner g pk + let mkCtData owners = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data"} + -- decryption fails: owner uses root key + let ud = mkCtData [owner {ownerKey = C.publicKey pk}] + err = A_LINK $ "owner key for ID " <> ownerIdStr owner <> " matches root key" + testEncDecFail g pk lnk ud err + testEncDecFail g ownerPK lnk ud err + -- decryption fails: duplicate owner ID or key + (ownerPK1, owner1) <- authNewOwner g pk + let ud1 = mkCtData [owner, owner1 {ownerId = ownerId owner}] + ud1' = mkCtData [owner, owner1 {ownerKey = ownerKey owner}] + err1 o = A_LINK $ "duplicate owner key or ID " <> ownerIdStr o + testEncDecFail g pk lnk ud1 $ err1 owner + testEncDecFail g pk lnk ud1' $ err1 owner1 + -- decryption fails: wrong order + (ownerPK2, owner2) <- authNewOwner g ownerPK + let ud2 = mkCtData [owner, owner1, owner2] + ud2' = mkCtData [owner, owner2, owner1] + testEncDec g pk lnk ud2 + testEncDec g pk lnk ud2' + testEncDec g ownerPK lnk ud2 + testEncDec g ownerPK1 lnk ud2 + testEncDec g ownerPK2 lnk ud2 + let ud2'' = mkCtData [owner2, owner, owner1] + err2 = A_LINK $ "invalid authorization of owner ID " <> ownerIdStr owner2 + testEncDecFail g pk lnk ud2'' err2 + -- decryption fails: authorized with wrong key + (_, wrongKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g + (_, owner3) <- authNewOwner g wrongKey + let ud3 = mkCtData [owner3] + ud3' = mkCtData [owner, owner1, owner2, owner3] + err3 = A_LINK $ "invalid authorization of owner ID " <> ownerIdStr owner3 + testEncDecFail g pk lnk ud3 err3 + testEncDecFail g pk lnk ud3' err3 + +testEncDecFail :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> (EncFixedDataBytes, LinkKey, C.SbKey) -> UserContactData -> SMPAgentError -> IO () +testEncDecFail g pk (fd, linkKey, k) ctData err = do + let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange $ UserContactLinkData ctData + Right ud <- runExceptT $ SL.encryptUserData g k signed + SL.decryptLinkData @'CMContact linkKey k (fd, ud) `shouldBe` Left (AGENT err) + +ownerIdStr :: OwnerAuth -> String +ownerIdStr OwnerAuth {ownerId} = B.unpack $ B64.encodeUnpadded ownerId From 89b81d151fa0378196d923c5d7fa0aea08462136 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Tue, 20 Jan 2026 08:40:35 +0000 Subject: [PATCH 2/3] agent: getConnShortLinkAsync; implement joinConnectionAsync for contact connections; narrow setConnShortLinkAsync only to Contact connections (#1694) * agent: getConnShortLinkAsync * enable all tests * comment * comment * join conn async for contact URI (wip) * fix test * remove enableNtfs param * FixedLinkData --------- Co-authored-by: Evgeny Poberezkin --- src/Simplex/Messaging/Agent.hs | 147 ++++++++++++------ src/Simplex/Messaging/Agent/Protocol.hs | 49 +++--- .../Messaging/Agent/Store/AgentStore.hs | 18 ++- src/Simplex/Messaging/Crypto/ShortLink.hs | 12 +- tests/AgentTests/EqInstances.hs | 6 +- tests/AgentTests/FunctionalAPITests.hs | 72 ++++++--- tests/AgentTests/ShortLinkTests.hs | 14 +- 7 files changed, 209 insertions(+), 109 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index f81add594..116c32b70 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -50,6 +50,7 @@ module Simplex.Messaging.Agent connRequestPQSupport, createConnectionAsync, setConnShortLinkAsync, + getConnShortLinkAsync, joinConnectionAsync, allowConnectionAsync, acceptContactAsync, @@ -198,8 +199,8 @@ import Simplex.Messaging.Client (NetworkRequestMode (..), SMPClientError, Server import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs) import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) -import qualified Simplex.Messaging.Crypto.ShortLink as SL import qualified Simplex.Messaging.Crypto.Ratchet as CR +import qualified Simplex.Messaging.Crypto.ShortLink as SL import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId, PNMessageData (..), pnMessagesP) @@ -347,13 +348,19 @@ createConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:. newConnAs {-# INLINE createConnectionAsync #-} -- | Create or update user's contact connection short link (LSET command) asynchronously, no synchronous response -setConnShortLinkAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE () -setConnShortLinkAsync c = withAgentEnv c .::. setConnShortLinkAsync' c +setConnShortLinkAsync :: AgentClient -> ACorrId -> ConnId -> UserConnLinkData 'CMContact -> Maybe CRClientData -> AE () +setConnShortLinkAsync c = withAgentEnv c .:: setConnShortLinkAsync' c {-# INLINE setConnShortLinkAsync #-} --- | 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 c userId aCorrId enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId enableNtfs +-- | Get and verify data from short link (LGET/LKEY command) asynchronously, synchronous response is new connection id +getConnShortLinkAsync :: AgentClient -> UserId -> ACorrId -> ConnShortLink 'CMContact -> AE ConnId +getConnShortLinkAsync c = withAgentEnv c .:. getConnShortLinkAsync' c +{-# INLINE getConnShortLinkAsync #-} + +-- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id. +-- If connId is provided (for contact URIs), it updates the existing connection record created by getConnShortLinkAsync. +joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId +joinConnectionAsync c userId aCorrId connId_ enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId connId_ enableNtfs {-# INLINE joinConnectionAsync #-} -- | Allow connection to continue after CONF notification (LET command), no synchronous response @@ -401,7 +408,7 @@ deleteConnShortLink c = withAgentEnv c .:. deleteConnShortLink' c {-# INLINE deleteConnShortLink #-} -- | Get and verify data from short link. For 1-time invitations it preserves the key to allow retries -getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c) +getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c) getConnShortLink c = withAgentEnv c .:. getConnShortLink' c {-# INLINE getConnShortLink #-} @@ -784,8 +791,9 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do -- TODO [short links] TBC, but probably we will need async join for contact addresses as the contact will be created after user confirming the connection, -- and join should retry, the same as 1-time invitation joins. -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 -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId +joinConnAsync c userId corrId connId_ enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do + when (isJust connId_) $ throwE $ CMD PROHIBITED "joinConnAsync: connId not allowed for invitation URI" withInvLock c (strEncode cReqUri) "joinConnAsync" $ do lift (compatibleInvitationUri cReqUri) >>= \case Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do @@ -796,8 +804,22 @@ 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" +joinConnAsync c userId corrId connId_ enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode = do + lift (compatibleContactUri cReqUri) >>= \case + Just (_, Compatible connAgentVersion) -> do + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing + connId <- case connId_ of + Just cId -> do + -- update connection record created by getConnShortLinkAsync + withStore' c $ \db -> updateNewConnJoin db cId connAgentVersion pqSupport enableNtfs + pure cId + Nothing -> do + g <- asks random + let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} + withStore c $ \db -> createNewConn db g cData SCMInvitation + enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo + pure connId + Nothing -> throwE $ AGENT A_VERSION allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM () allowConnectionAsync' c corrId connId confId ownConnInfo = @@ -816,7 +838,7 @@ acceptContactAsync' :: AgentClient -> UserId -> ACorrId -> Bool -> InvitationId acceptContactAsync' c userId corrId enableNtfs invId ownConnInfo pqSupport subMode = do Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId withStore' c $ \db -> acceptInvitation db invId ownConnInfo - joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do + joinConnAsync c userId corrId Nothing enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do withStore' c (`unacceptInvitation` invId) throwE err @@ -876,8 +898,9 @@ newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKey srv <- getSMPServer c userId when (checkNotices && connMode cMode == CMContact) $ checkClientNotices c srv connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys) - (connId,) <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys subMode srv - `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e + (connId,) + <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys subMode srv + `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e checkClientNotices :: AgentClient -> SMPServerWithAuth -> AM () checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAuth srv@(ProtocolServer {host}) _) = do @@ -892,17 +915,41 @@ checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAu when (maybe True (ts <) expires_) $ throwError NOTICE {server = safeDecodeUtf8 $ strEncode $ L.head host, preset = isNothing srvKey, expiresAt = roundedToUTCTime <$> expires_} -setConnShortLinkAsync' :: forall c. ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM () -setConnShortLinkAsync' c corrId connId cMode userLinkData clientData = +setConnShortLinkAsync' :: AgentClient -> ACorrId -> ConnId -> UserConnLinkData 'CMContact -> Maybe CRClientData -> AM () +setConnShortLinkAsync' c corrId connId userLinkData clientData = withConnLock c connId "setConnShortLinkAsync" $ do SomeConn _ conn <- withStore c (`getConn` connId) - srv <- case (conn, cMode, userLinkData) of - (ContactConnection _ RcvQueue {server, shortLink}, SCMContact, UserContactLinkData d) -> do - liftEitherWith (CMD PROHIBITED . ("setConnShortLinkAsync: " <> )) $ validateOwners shortLink d + srv <- case (conn, userLinkData) of + (ContactConnection _ RcvQueue {server, shortLink}, UserContactLinkData d) -> do + liftEitherWith (CMD PROHIBITED . ("setConnShortLinkAsync: " <>)) $ validateOwners shortLink d pure server - (RcvConnection _ RcvQueue {server}, SCMInvitation, UserInvLinkData {}) -> pure server _ -> throwE $ CMD PROHIBITED "setConnShortLinkAsync: invalid connection or mode" - enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET (AULD cMode userLinkData) clientData + enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET userLinkData clientData + +getConnShortLinkAsync' :: AgentClient -> UserId -> ACorrId -> ConnShortLink 'CMContact -> AM ConnId +getConnShortLinkAsync' c userId corrId shortLink@(CSLContact _ _ srv _) = do + g <- asks random + connId <- withStore c $ \db -> do + -- server is created so the command is processed in server queue, + -- not blocking other "no server" commands + void $ createServer db srv + prepareNewConn db g + enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LGET shortLink + pure connId + where + prepareNewConn db g = do + let cData = + ConnData + { userId, + connId = "", + connAgentVersion = currentSMPAgentVersion, + enableNtfs = False, + lastExternalSndId = 0, + deleted = False, + ratchetSyncState = RSOk, + pqSupport = PQSupportOff + } + createNewConn db g cData SCMInvitation setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM (ConnShortLink c) setConnShortLink' c nm connId cMode userLinkData clientData = @@ -917,7 +964,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData = where prepareContactLinkData :: RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData) prepareContactLinkData rq@RcvQueue {shortLink} ud@(UserContactLinkData d') = do - liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <> )) $ validateOwners shortLink d' + liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink d' g <- asks random AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config let cslContact = CSLContact SLSServer CCTContact (qServer rq) @@ -958,7 +1005,7 @@ deleteConnShortLink' c nm connId cMode = _ -> throwE $ CMD PROHIBITED "deleteConnShortLink: 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 -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (ConnectionRequestUri c, ConnLinkData c) +getConnShortLink' :: forall c. AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (FixedLinkData c, ConnLinkData c) getConnShortLink' c nm userId = \case CSLInvitation _ srv linkId linkKey -> do g <- asks random @@ -979,18 +1026,19 @@ getConnShortLink' c nm userId = \case ld <- getQueueLink c nm userId srv linkId decryptData srv linkKey k ld where - decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (ConnectionRequestUri c, ConnLinkData c) + decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (FixedLinkData c, ConnLinkData c) decryptData srv linkKey k (sndId, d) = do - r@(cReq, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d - let (srv', sndId') = qAddress (connReqQueue cReq) - unless (srv `sameSrvHost` srv' && sndId == sndId') $ - throwE $ AGENT $ A_LINK "different address" - pure $ if srv' == srv then r else (updateConnReqServer srv cReq, clData) + r@(fd, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d + let (srv', sndId') = qAddress (connReqQueue $ linkConnReq fd) + unless (srv `sameSrvHost` srv' && sndId == sndId') $ throwE $ AGENT $ A_LINK "different address" + pure $ if srv' == srv then r else (updateConnReqServer srv fd, clData) sameSrvHost ProtocolServer {host = h :| _} ProtocolServer {host = hs} = h `elem` hs - updateConnReqServer :: SMPServer -> ConnectionRequestUri c -> ConnectionRequestUri c - updateConnReqServer srv = \case - CRInvitationUri crData e2eParams -> CRInvitationUri (updateQueues crData) e2eParams - CRContactUri crData -> CRContactUri $ updateQueues crData + updateConnReqServer :: SMPServer -> FixedLinkData c -> FixedLinkData c + updateConnReqServer srv fd = + let connReq' = case linkConnReq fd of + CRInvitationUri crData e2eParams -> CRInvitationUri (updateQueues crData) e2eParams + CRContactUri crData -> CRContactUri $ updateQueues crData + in fd {linkConnReq = connReq'} where updateQueues crData@(ConnReqUriData {crSmpQueues = SMPQueueUri vr addr :| qs}) = crData {crSmpQueues = SMPQueueUri vr addr {smpServer = srv} :| qs} @@ -1073,7 +1121,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni connReqWithShortLink :: SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> Maybe ShortLinkCreds -> AM (CreatedConnLink c) connReqWithShortLink qUri cReq qUri' shortLink = case shortLink of Just ShortLinkCreds {shortLinkId, shortLinkKey} - | qUri == qUri' -> pure $ case cReq of + | qUri == qUri' -> pure $ case cReq of CRContactUri _ -> CCLink cReq $ Just $ CSLContact SLSServer CCTContact srv shortLinkKey CRInvitationUri crData (CR.E2ERatchetParamsUri vr k1 k2 _) -> let cReq' = case pqInitKeys of @@ -1334,7 +1382,7 @@ databaseDiff passed known = let passedSet = S.fromList passed knownSet = S.fromList known missingIds = S.toList $ passedSet `S.difference` knownSet - extraIds = S.toList $ knownSet `S.difference` passedSet + extraIds = S.toList $ knownSet `S.difference` passedSet in DatabaseDiff {missingIds, extraIds} -- | Subscribe to receive connection messages (SUB command) in Reader monad @@ -1372,7 +1420,8 @@ subscribeConnections_ c conns = do notifyResultError rs pure rs where - partitionResultsConns :: (ConnId, Either StoreError SomeConnSub) -> + partitionResultsConns :: + (ConnId, Either StoreError SomeConnSub) -> (Map ConnId (Either AgentErrorType (Maybe ClientServiceId)), [(ConnId, SomeConnSub)]) -> (Map ConnId (Either AgentErrorType (Maybe ClientServiceId)), [(ConnId, SomeConnSub)]) partitionResultsConns (connId, conn_) (rs, cs) = case conn_ of @@ -1679,15 +1728,26 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do (CCLink cReq _, service) <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv notify $ INV (ACR cMode cReq) service - LSET auData@(AULD cMode userLinkData) clientData -> + LSET userLinkData clientData -> withServer' . tryCommand $ do - link <- setConnShortLink' c NRMBackground connId cMode userLinkData clientData - notify $ LINK (ACSL cMode link) auData + link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData + notify $ LINK link userLinkData + LGET shortLink -> + withServer' . tryCommand $ do + (fixedData, linkData) <- getConnShortLink' c NRMBackground userId shortLink + notify $ LDATA fixedData linkData JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do (sqSecured, service) <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv notify $ JOINED sqSecured service + -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously. + -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously. + JOIN enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc subMode connInfo -> noServer $ do + triedHosts <- newTVarIO S.empty + tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do + (sqSecured, service) <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo pqEnc subMode srv + notify $ JOINED sqSecured service LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK SWCH -> @@ -1697,7 +1757,6 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do switchDuplexConnection c NRMBackground conn replaced >>= notify . SWITCH QDRcv SPStarted _ -> throwE $ CMD PROHIBITED "SWCH: not duplex" DEL -> withServer' . tryCommand $ deleteConnection' c NRMBackground connId >> notify OK - _ -> notify $ ERR $ INTERNAL $ "unsupported async command " <> show (aCommandTag cmd) AInternalCommand cmd -> case cmd of ICAckDel rId srvMsgId msgId -> withServer $ \srv -> tryWithLock "ICAckDel" $ ack srv rId srvMsgId >> withStore' c (\db -> deleteMsg db connId msgId) ICAck rId srvMsgId -> withServer $ \srv -> tryWithLock "ICAck" $ ack srv rId srvMsgId @@ -1861,7 +1920,7 @@ enqueueMessageB c reqs = do storeSentMsg db cfg aMessageIds = \case Left e -> pure (aMessageIds, Left e) Right req@(csqs_, pqEnc_, msgFlags, mbr) -> case mbr of - VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of + VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of Just _ -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg duplicate saved message body") Nothing -> do (mbId_, r) <- case csqs_ of @@ -1903,7 +1962,6 @@ enqueueMessageB c reqs = do handleInternal :: E.SomeException -> IO (Either AgentErrorType b) handleInternal = pure . Left . INTERNAL . show - encodeAgentMsgStr :: AMessage -> InternalSndId -> PrevSndMsgHash -> ByteString encodeAgentMsgStr aMessage internalSndId prevMsgHash = do let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash @@ -2324,7 +2382,8 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do forM_ cIds_ $ \cIds -> notify ("", "", AEvt SAEConn $ DEL_CONNS cIds) pure res where - partitionResultsConns :: (ConnId, Either StoreError SomeConn) -> + partitionResultsConns :: + (ConnId, Either StoreError SomeConn) -> (Map ConnId (Either AgentErrorType ()), [RcvQueue], [ConnId]) -> (Map ConnId (Either AgentErrorType ()), [RcvQueue], [ConnId]) partitionResultsConns (connId, conn_) (rs, rqs, cIds) = case conn_ of @@ -2332,7 +2391,7 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do Right (SomeConn _ conn) -> case connRcvQueues conn of [] -> (M.insert connId (Right ()) rs, rqs, cIds) rqs' -> (rs, rqs' ++ rqs, connId : cIds) - unsubNtfConnIds :: NonEmpty ConnId -> AM' () + unsubNtfConnIds :: NonEmpty ConnId -> AM' () unsubNtfConnIds connIds' = do ns <- asks ntfSupervisor atomically $ writeTBQueue (ntfSubQ ns) (NSCDeleteSub, connIds') diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index cf511482f..46d5ebaa9 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -20,8 +20,8 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} +{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} -- | -- Module : Simplex.Messaging.Agent.Protocol @@ -112,6 +112,7 @@ module Simplex.Messaging.Agent.Protocol CRClientData, ServiceScheme, FixedLinkData (..), + AConnLinkData (..), ConnLinkData (..), AUserConnLinkData (..), UserConnLinkData (..), @@ -255,10 +256,10 @@ import Simplex.Messaging.Protocol legacyStrEncodeServer, noAuthSrv, sameSrvAddr, + senderCanSecure, + shortLinksSMPClientVersion, sndAuthKeySMPClientVersion, srvHostnamesSMPClientVersion, - shortLinksSMPClientVersion, - senderCanSecure, pattern ProtoServerWithAuth, pattern SMPServer, ) @@ -386,7 +387,8 @@ type SndQueueSecured = Bool -- | Parameterized type for SMP agent events data AEvent (e :: AEntity) where INV :: AConnectionRequestUri -> Maybe ClientServiceId -> AEvent AEConn - LINK :: AConnShortLink -> AUserConnLinkData -> AEvent AEConn + LINK :: ConnShortLink 'CMContact -> UserConnLinkData 'CMContact -> AEvent AEConn + LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> AEvent AEConn CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender INFO :: PQSupport -> ConnInfo -> AEvent AEConn @@ -440,7 +442,8 @@ deriving instance Show AEvtTag data ACommand = NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV - | LSET AUserConnLinkData (Maybe CRClientData) -- response LINK + | LSET (UserConnLinkData 'CMContact) (Maybe CRClientData) -- response LINK + | LGET (ConnShortLink 'CMContact) -- response LDATA | JOIN Bool AConnectionRequestUri PQSupport SubscriptionMode ConnInfo | LET ConfirmationId ConnInfo -- ConnInfo is from client | ACK AgentMsgId (Maybe MsgReceiptInfo) @@ -451,6 +454,7 @@ data ACommand data ACommandTag = NEW_ | LSET_ + | LGET_ | JOIN_ | LET_ | ACK_ @@ -461,6 +465,7 @@ data ACommandTag data AEventTag (e :: AEntity) where INV_ :: AEventTag AEConn LINK_ :: AEventTag AEConn + LDATA_ :: AEventTag AEConn CONF_ :: AEventTag AEConn REQ_ :: AEventTag AEConn INFO_ :: AEventTag AEConn @@ -508,6 +513,7 @@ aCommandTag :: ACommand -> ACommandTag aCommandTag = \case NEW {} -> NEW_ LSET {} -> LSET_ + LGET _ -> LGET_ JOIN {} -> JOIN_ LET {} -> LET_ ACK {} -> ACK_ @@ -518,6 +524,7 @@ aEventTag :: AEvent e -> AEventTag e aEventTag = \case INV {} -> INV_ LINK {} -> LINK_ + LDATA {} -> LDATA_ CONF {} -> CONF_ REQ {} -> REQ_ INFO {} -> INFO_ @@ -1706,14 +1713,19 @@ type CRClientData = Text data FixedLinkData c = FixedLinkData { agentVRange :: VersionRangeSMPA, rootKey :: C.PublicKeyEd25519, - connReq :: ConnectionRequestUri c, + linkConnReq :: ConnectionRequestUri c, linkEntityId :: Maybe ByteString } + deriving (Eq, Show) data ConnLinkData c where InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation ContactLinkData :: VersionRangeSMPA -> UserContactData -> ConnLinkData 'CMContact +deriving instance Eq (ConnLinkData c) + +deriving instance Show (ConnLinkData c) + data UserContactData = UserContactData { -- direct connection via connReq in fixed data is allowed. direct :: Bool, @@ -1740,13 +1752,6 @@ deriving instance Show (UserConnLinkData m) data AUserConnLinkData = forall m. ConnectionModeI m => AULD (SConnectionMode m) (UserConnLinkData m) -instance Eq AUserConnLinkData where - AULD m d == AULD m' d' = case testEquality m m' of - Just Refl -> d == d' - Nothing -> False - -deriving instance Show AUserConnLinkData - linkUserData :: ConnLinkData c -> UserLinkData linkUserData = \case InvitationLinkData _ d -> d @@ -1787,10 +1792,10 @@ validateOwners shortLink_ UserContactData {owners} = case shortLink_ of where hasOwner = isNothing linkRootSigKey || any ((k ==) . ownerKey) owners k = C.publicKey linkPrivSigKey - + validateLinkOwners :: C.PublicKeyEd25519 -> [OwnerAuth] -> Either String () validateLinkOwners rootKey = go [] - where + where go _ [] = Right () go prev (o : os) = validOwner o >> go (o : prev) os where @@ -1805,12 +1810,12 @@ validateLinkOwners rootKey = go [] signedBy k' = C.verify' k' sig (oId <> C.encodePubKey k) instance ConnectionModeI c => Encoding (FixedLinkData c) where - smpEncode FixedLinkData {agentVRange, rootKey, connReq, linkEntityId} = - smpEncode (agentVRange, rootKey, connReq) <> maybe "" smpEncode linkEntityId + smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} = + smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId smpP = do - (agentVRange, rootKey, connReq) <- smpP + (agentVRange, rootKey, linkConnReq) <- smpP linkEntityId <- (smpP <|> pure Nothing) <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding - pure FixedLinkData {agentVRange, rootKey, connReq, linkEntityId} + pure FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} instance ConnectionModeI c => Encoding (ConnLinkData c) where smpEncode = \case @@ -1849,7 +1854,7 @@ instance Encoding AUserConnLinkData where CMContact -> AULD SCMContact . UserContactLinkData <$> smpP -instance StrEncoding AUserConnLinkData where +instance ConnectionModeI c => StrEncoding (UserConnLinkData c) where strEncode = smpEncode {-# INLINE strEncode #-} strP = smpP @@ -2065,6 +2070,7 @@ instance StrEncoding ACommandTag where A.takeTill (== ' ') >>= \case "NEW" -> pure NEW_ "LSET" -> pure LSET_ + "LGET" -> pure LGET_ "JOIN" -> pure JOIN_ "LET" -> pure LET_ "ACK" -> pure ACK_ @@ -2074,6 +2080,7 @@ instance StrEncoding ACommandTag where strEncode = \case NEW_ -> "NEW" LSET_ -> "LSET" + LGET_ -> "LGET" JOIN_ -> "JOIN" LET_ -> "LET" ACK_ -> "ACK" @@ -2086,6 +2093,7 @@ commandP binaryP = >>= \case NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe)) LSET_ -> s (LSET <$> strP <*> optional (A.space *> strP)) + LGET_ -> s (LGET <$> strP) JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqSupP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP) LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP) ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP)) @@ -2104,6 +2112,7 @@ serializeCommand :: ACommand -> ByteString serializeCommand = \case NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode) LSET uld cd_ -> s (LSET_, uld) <> maybe "" (B.cons ' ' . s) cd_ + LGET sl -> s (LGET_, sl) JOIN ntfs cReq pqSup subMode cInfo -> s (JOIN_, ntfs, cReq, pqSup, subMode, Str $ serializeBinary cInfo) LET confId cInfo -> B.unwords [s LET_, confId, serializeBinary cInfo] ACK mId rcptInfo_ -> s (ACK_, mId) <> maybe "" (B.cons ' ' . serializeBinary) rcptInfo_ diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index ce6e71a5e..711f6f05b 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -36,6 +36,7 @@ module Simplex.Messaging.Agent.Store.AgentStore checkUser, -- * Queues and connections + createServer, createNewConn, updateNewConnRcv, updateNewConnSnd, @@ -57,6 +58,7 @@ module Simplex.Messaging.Agent.Store.AgentStore setConnUserId, setConnAgentVersion, setConnPQSupport, + updateNewConnJoin, getDeletedConnIds, getDeletedWaitingDeliveryConnIds, setConnRatchetSync, @@ -432,7 +434,7 @@ createSndConn db gVar cData q@SndQueue {server} = -- check confirmed snd queue doesn't already exist, to prevent it being deleted by REPLACE in insertSndQueue_ ifM (liftIO $ checkConfirmedSndQueueExists_ db q) (pure $ Left SESndQueueExists) $ createConn_ db gVar cData $ \connId -> do - serverKeyHash_ <- createServer_ db server + serverKeyHash_ <- createServer db server createConnRecord db connId cData SCMInvitation insertSndQueue_ db connId q serverKeyHash_ @@ -519,7 +521,7 @@ addConnRcvQueue db connId rq subMode = addConnRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO RcvQueue addConnRcvQueue_ db connId rq@RcvQueue {server} subMode = do - serverKeyHash_ <- createServer_ db server + serverKeyHash_ <- createServer db server insertRcvQueue_ db connId rq subMode serverKeyHash_ addConnSndQueue :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreError SndQueue) @@ -531,7 +533,7 @@ addConnSndQueue db connId sq = addConnSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> IO SndQueue addConnSndQueue_ db connId sq@SndQueue {server} = do - serverKeyHash_ <- createServer_ db server + serverKeyHash_ <- createServer db server insertSndQueue_ db connId sq serverKeyHash_ setRcvQueueStatus :: DB.Connection -> RcvQueue -> QueueStatus -> IO () @@ -829,7 +831,7 @@ deleteInvShortLink db srv lnkId = createInvShortLink :: DB.Connection -> InvShortLink -> IO () createInvShortLink db InvShortLink {server, linkId, linkKey, sndPrivateKey, sndId} = do - serverKeyHash_ <- createServer_ db server + serverKeyHash_ <- createServer db server DB.execute db [sql| @@ -2024,8 +2026,8 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, -- * Server helper -- | Creates a new server, if it doesn't exist, and returns the passed key hash if it is different from stored. -createServer_ :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash) -createServer_ db newSrv@ProtocolServer {host, port, keyHash} = do +createServer :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash) +createServer db newSrv@ProtocolServer {host, port, keyHash} = do r <- insertNewServer_ if null r then getServerKeyHash_ db newSrv >>= either E.throwIO pure @@ -2406,6 +2408,10 @@ setConnPQSupport :: DB.Connection -> ConnId -> PQSupport -> IO () setConnPQSupport db connId pqSupport = DB.execute db "UPDATE connections SET pq_support = ? WHERE conn_id = ?" (pqSupport, connId) +updateNewConnJoin :: DB.Connection -> ConnId -> VersionSMPA -> PQSupport -> Bool -> IO () +updateNewConnJoin db connId aVersion pqSupport enableNtfs = + DB.execute db "UPDATE connections SET smp_agent_version = ?, pq_support = ?, enable_ntfs = ? WHERE conn_id = ?" (aVersion, pqSupport, BI enableNtfs, connId) + getDeletedConnIds :: DB.Connection -> IO [ConnId] getDeletedConnIds db = map fromOnly <$> DB.query db "SELECT conn_id FROM connections WHERE deleted = ?" (Only (BI True)) diff --git a/src/Simplex/Messaging/Crypto/ShortLink.hs b/src/Simplex/Messaging/Crypto/ShortLink.hs index 962c1aecc..ae9049889 100644 --- a/src/Simplex/Messaging/Crypto/ShortLink.hs +++ b/src/Simplex/Messaging/Crypto/ShortLink.hs @@ -33,7 +33,7 @@ import Simplex.Messaging.Agent.Client (cryptoError) import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding -import Simplex.Messaging.Protocol (EntityId (..), LinkId, EncDataBytes (..), QueueLinkData) +import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), LinkId, QueueLinkData) import Simplex.Messaging.Util (liftEitherWith) fixedDataPaddedLength :: Int @@ -51,8 +51,8 @@ invShortLinkKdf :: LinkKey -> C.SbKey invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32 encodeSignLinkData :: ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> UserConnLinkData c -> (LinkKey, (ByteString, ByteString)) -encodeSignLinkData (rootKey, pk) agentVRange connReq userData = - let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq, linkEntityId = Nothing} +encodeSignLinkData (rootKey, pk) agentVRange linkConnReq userData = + let fd = smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId = Nothing} md = smpEncode $ connLinkData agentVRange userData in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk md)) @@ -82,11 +82,11 @@ encryptData g k len s = do ct <- liftEitherWith cryptoError $ C.sbEncrypt k nonce s len pure $ EncDataBytes $ smpEncode nonce <> ct -decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (ConnectionRequestUri c, ConnLinkData c) +decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (FixedLinkData c, ConnLinkData c) decryptLinkData linkKey k (encFD, encMD) = do (sig1, fd) <- decrypt encFD (sig2, md) <- decrypt encMD - FixedLinkData {rootKey, connReq} <- decode fd + fd'@FixedLinkData {rootKey} <- decode fd md' <- decode @(ConnLinkData c) md let signedBy k' = C.verify' k' sig2 md if @@ -97,7 +97,7 @@ decryptLinkData linkKey k (encFD, encMD) = do ContactLinkData _ UserContactData {owners} -> do first (AGENT . A_LINK) $ validateLinkOwners rootKey owners unless (signedBy rootKey || any (signedBy . ownerKey) owners) $ linkErr "user data signature" - Right (connReq, md') + Right (fd', md') where decrypt (EncDataBytes d) = do (nonce, Tail ct) <- decode d diff --git a/tests/AgentTests/EqInstances.hs b/tests/AgentTests/EqInstances.hs index b33980f6a..b01174343 100644 --- a/tests/AgentTests/EqInstances.hs +++ b/tests/AgentTests/EqInstances.hs @@ -5,7 +5,7 @@ module AgentTests.EqInstances where import Data.Type.Equality -import Simplex.Messaging.Agent.Protocol (ConnLinkData (..), ShortLinkCreds (..)) +import Simplex.Messaging.Agent.Protocol (ShortLinkCreds (..)) import Simplex.Messaging.Agent.Store import Simplex.Messaging.Client (ProxiedRelay (..)) @@ -28,10 +28,6 @@ deriving instance Eq ClientNtfCreds deriving instance Eq ShortLinkCreds -deriving instance Show (ConnLinkData c) - -deriving instance Eq (ConnLinkData c) - deriving instance Show ProxiedRelay deriving instance Eq ProxiedRelay diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 09c873d31..be873befb 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -313,7 +313,7 @@ deleteConnection c = A.deleteConnection c NRMInteractive deleteConnections :: AgentClient -> [ConnId] -> AE (M.Map ConnId (Either AgentErrorType ())) deleteConnections c = A.deleteConnections c NRMInteractive -getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c) +getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c) getConnShortLink c = A.getConnShortLink c NRMInteractive setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c) @@ -458,6 +458,8 @@ functionalAPITests ps = do testBasicMatrix2 ps testAsyncCommands it "should add short link data using async agent command" $ testSetConnShortLinkAsync ps + it "should get short link data and join connection using async agent commands" $ + testGetConnShortLinkAsync ps it "should restore and complete async commands on restart" $ testAsyncCommandsRestore ps describe "accept connection using async command" $ @@ -1369,12 +1371,12 @@ testInvitationShortLink viaProxy a b = let userData = UserLinkData "some user data" newLinkData = UserInvLinkData userData (bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe - (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq linkUserData connData' `shouldBe` userData -- same user can get invitation link again - (connReq2, connData2) <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq2}, connData2) <- runRight $ getConnShortLink b 1 shortLink connReq2 `shouldBe` connReq linkUserData connData2 `shouldBe` userData -- another user cannot get the same invitation link @@ -1412,12 +1414,12 @@ testInvitationShortLinkAsync viaProxy a b = do let userData = UserLinkData "some user data" newLinkData = UserInvLinkData userData (bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe - (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq linkUserData connData' `shouldBe` userData runRight $ do - aId <- A.joinConnectionAsync b 1 "123" True connReq "bob's connInfo" PQSupportOn SMSubscribe + aId <- A.joinConnectionAsync b 1 "123" Nothing True connReq "bob's connInfo" PQSupportOn SMSubscribe get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False ("", _, CONF confId _ "bob's connInfo") <- get a allowConnection a bId confId "alice's connInfo" @@ -1440,16 +1442,16 @@ testContactShortLink viaProxy a b = newLinkData = UserContactLinkData userCtData (contactId, (CCLink connReq0 (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMSubscribe Right connReq <- pure $ smpDecode (smpEncode connReq0) - (connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq userCtData' `shouldBe` userCtData -- same user can get contact link again - (connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink connReq2 `shouldBe` connReq userCtData2 `shouldBe` userCtData -- another user can get the same contact link - (connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink + (FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink connReq3 `shouldBe` connReq userCtData3 `shouldBe` userCtData runRight $ do @@ -1471,7 +1473,7 @@ testContactShortLink viaProxy a b = userLinkData' = UserContactLinkData updatedCtData shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink - (connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink + (FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink connReq4 `shouldBe` connReq updatedCtData' `shouldBe` updatedCtData -- one more time @@ -1491,16 +1493,16 @@ testAddContactShortLink viaProxy a b = userCtData = UserContactData {direct = True, owners = [], relays = [], userData} newLinkData = UserContactLinkData userCtData shortLink <- runRight $ setConnShortLink a contactId SCMContact newLinkData Nothing - (connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq userCtData' `shouldBe` userCtData -- same user can get contact link again - (connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink connReq2 `shouldBe` connReq userCtData2 `shouldBe` userCtData -- another user can get the same contact link - (connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink + (FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink connReq3 `shouldBe` connReq userCtData3 `shouldBe` userCtData runRight $ do @@ -1522,7 +1524,7 @@ testAddContactShortLink viaProxy a b = userLinkData' = UserContactLinkData updatedCtData shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink - (connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink + (FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink connReq4 `shouldBe` connReq updatedCtData' `shouldBe` updatedCtData @@ -1534,7 +1536,7 @@ testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMOnlyCreate withSmpServer ps $ do runRight_ $ subscribeConnection a bId - (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq linkUserData connData' `shouldBe` userData @@ -1623,7 +1625,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do userCtData = UserContactData {direct = True, owners = [], relays = [], userData} userLinkData = UserContactLinkData userCtData shortLink <- runRight $ setConnShortLink a contactId SCMContact userLinkData Nothing - (connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq userCtData' `shouldBe` userCtData @@ -1634,7 +1636,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink -- check updated - (connReq'', ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq''}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink connReq'' `shouldBe` connReq updatedCtData' `shouldBe` updatedCtData @@ -2617,7 +2619,7 @@ testAsyncCommands sqSecured alice bob baseId = bobId <- createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe ("1", bobId', INV (ACR _ qInfo)) <- get alice liftIO $ bobId' `shouldBe` bobId - aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe + aliceId <- joinConnectionAsync bob 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe ("2", aliceId', JOINED sqSecured') <- get bob liftIO $ do aliceId' `shouldBe` aliceId @@ -2675,8 +2677,8 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> -- update link data async let updatedData = UserLinkData "updated user data" updatedCtData = UserContactData {direct = False, owners = [], relays = [], userData = updatedData} - setConnShortLinkAsync alice "1" cId SCMContact (UserContactLinkData updatedCtData) Nothing - ("1", cId', LINK (ACSL SCMContact shortLink') (AULD SCMContact (UserContactLinkData updatedCtData'))) <- get alice + setConnShortLinkAsync alice "1" cId (UserContactLinkData updatedCtData) Nothing + ("1", cId', LINK shortLink' (UserContactLinkData updatedCtData')) <- get alice liftIO $ cId' `shouldBe` cId liftIO $ shortLink' `shouldBe` shortLink liftIO $ updatedCtData' `shouldBe` updatedCtData @@ -2694,6 +2696,34 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> get alice ##> ("", bobId, CON) get bob ##> ("", aliceId, CON) +testGetConnShortLinkAsync :: (ASrvTransport, AStoreType) -> IO () +testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> + withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do + let userData = UserLinkData "test user data" + userCtData = UserContactData {direct = True, owners = [], relays = [], userData} + newLinkData = UserContactLinkData userCtData + (_, (CCLink qInfo (Just shortLink), _)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe + -- get link data async - creates new connection for bob + newId <- getConnShortLinkAsync bob 1 "1" shortLink + ("1", newId', LDATA FixedLinkData {linkConnReq = qInfo'} (ContactLinkData _ userCtData')) <- get bob + liftIO $ newId' `shouldBe` newId + liftIO $ qInfo' `shouldBe` qInfo + liftIO $ userCtData' `shouldBe` userCtData + -- join connection async using connId from getConnShortLinkAsync + aliceId <- joinConnectionAsync bob 1 "2" (Just newId) True qInfo' "bob's connInfo" PQSupportOn SMSubscribe + liftIO $ aliceId `shouldBe` newId + ("2", aliceId', JOINED False) <- get bob + liftIO $ aliceId' `shouldBe` aliceId + -- complete connection + ("", _, REQ invId _ "bob's connInfo") <- get alice + bobId <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn + (_, Nothing) <- acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe + ("", _, CONF confId _ "alice's connInfo") <- get bob + allowConnection bob aliceId confId "bob's connInfo" + get alice ##> ("", bobId, INFO "bob's connInfo") + get alice ##> ("", bobId, CON) + get bob ##> ("", aliceId, CON) + testAsyncCommandsRestore :: (ASrvTransport, AStoreType) -> IO () testAsyncCommandsRestore ps = do alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB @@ -2987,7 +3017,7 @@ testJoinConnectionAsyncReplyErrorV8 ps@(t, ASType qsType _) = do bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId - aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe + aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId pure (aId, bId) @@ -3032,7 +3062,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId - aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe + aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId pure (aId, bId) diff --git a/tests/AgentTests/ShortLinkTests.hs b/tests/AgentTests/ShortLinkTests.hs index ab6062c30..97472bec1 100644 --- a/tests/AgentTests/ShortLinkTests.hs +++ b/tests/AgentTests/ShortLinkTests.hs @@ -12,12 +12,12 @@ import AgentTests.EqInstances () import Control.Concurrent.STM import Control.Monad.Except import Crypto.Random (ChaChaDRG) -import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Base64.URL as B64 -import Simplex.Messaging.Encoding.String +import qualified Data.ByteString.Char8 as B import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Crypto as C import qualified Simplex.Messaging.Crypto.ShortLink as SL +import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol (EncFixedDataBytes) import Test.Hspec hiding (fit, it) import Util @@ -48,7 +48,7 @@ testInvShortLink = do k = SL.invShortLinkKdf linkKey Right srvData <- runExceptT $ SL.encryptLinkData g k linkData -- decrypt - Right (connReq, connData') <- pure $ SL.decryptLinkData linkKey k srvData + Right (FixedLinkData {linkConnReq = connReq}, connData') <- pure $ SL.decryptLinkData linkKey k srvData connReq `shouldBe` invConnRequest linkUserData connData' `shouldBe` userData @@ -86,7 +86,7 @@ testContactShortLink = do (_linkId, k) = SL.contactShortLinkKdf linkKey Right srvData <- runExceptT $ SL.encryptLinkData g k linkData -- decrypt - Right (connReq, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData + Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData connReq `shouldBe` contactConnRequest userCtData' `shouldBe` userCtData @@ -108,7 +108,7 @@ testUpdateContactShortLink = do signed = SL.encodeSignUserData SCMContact (snd sigKeys) supportedSMPAgentVRange userLinkData' Right ud' <- runExceptT $ SL.encryptUserData g k signed -- decrypt - Right (connReq, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud') + Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud') connReq `shouldBe` contactConnRequest userCtData'' `shouldBe` userCtData' @@ -148,7 +148,7 @@ testContactShortLinkBadSignature = do -- decryption fails SL.decryptLinkData @'CMContact linkKey k (fd, ud') `shouldBe` Left (AGENT (A_LINK "user data signature")) - + testContactShortLinkOwner :: IO () testContactShortLinkOwner = do -- encrypt @@ -183,7 +183,7 @@ testEncDec :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> (EncFixedDataBytes, LinkK testEncDec g pk (fd, linkKey, k) ctData = do let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange $ UserContactLinkData ctData Right ud <- runExceptT $ SL.encryptUserData g k signed - Right (connReq', ContactLinkData _ ctData') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud) + Right (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ ctData') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud) connReq' `shouldBe` contactConnRequest ctData' `shouldBe` ctData From a1596ed234d43ef90bac8941b03b81528b7ede27 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sat, 24 Jan 2026 13:33:17 +0000 Subject: [PATCH 3/3] docs: contributing guide (#1702) --- contributing/CODE.md | 79 ++++++++++++++++++++++++++++++ contributing/PROJECT.md | 105 ++++++++++++++++++++++++++++++++++++++++ contributing/README.md | 22 +++++++++ 3 files changed, 206 insertions(+) create mode 100644 contributing/CODE.md create mode 100644 contributing/PROJECT.md create mode 100644 contributing/README.md diff --git a/contributing/CODE.md b/contributing/CODE.md new file mode 100644 index 000000000..415d40475 --- /dev/null +++ b/contributing/CODE.md @@ -0,0 +1,79 @@ +# Coding and building + +This file provides guidance on coding style and approaches and on building the code. + +## Code Style and Formatting + +The project uses **fourmolu** for Haskell code formatting. Configuration is in `fourmolu.yaml`. + +**Key formatting rules:** +- 2-space indentation +- Trailing function arrows, commas, and import/export style +- Record brace without space: `{field = value}` +- Single newline between declarations +- Never use unicode symbols +- Inline `let` style with right-aligned `in` + +**Format code before committing:** + +```bash +# Format a single file +fourmolu -i src/Simplex/Messaging/Protocol.hs +``` + +Some files that use CPP language extension cannot be formatted as a whole, so individual code fragments need to be formatted. + +**Follow existing code patterns:** +- Match the style of surrounding code +- Use qualified imports with short aliases (e.g., `import qualified Data.ByteString.Char8 as B`) +- Use record syntax for types with multiple fields +- Prefer explicit pattern matching over partial functions + +**Comments policy:** +- Avoid redundant comments that restate what the code already says +- Only comment on non-obvious design decisions or tricky implementation details +- Function names and type signatures should be self-documenting +- Do not add comments like "wire format encoding" (Encoding class is always wire format) or "check if X" when the function name already says that +- Assume a competent Haskell reader + +### Haskell Extensions +- `StrictData` enabled by default +- Use STM for safe concurrency +- Assume concurrency in PostgreSQL queries +- Comprehensive warning flags with strict pattern matching + +## Build Commands + +```bash +# Standard build +cabal build + +# Fast build +cabal build --ghc-options -O0 + +# Build specific executables +cabal build exe:smp-server exe:xftp-server exe:ntf-server exe:xftp + +# Build with PostgreSQL server support +cabal build -fserver_postgres + +# Client-only library build (no server code) +cabal build -fclient_library + +# Find binary location +cabal list-bin exe:smp-server +``` + +### Cabal Flags + +- `swift`: Enable Swift JSON format +- `client_library`: Build without server code +- `client_postgres`: Use PostgreSQL instead of SQLite for agent persistence +- `server_postgres`: PostgreSQL support for server queue/notification store + +## External Dependencies + +Custom forks specified in `cabal.project`: +- `aeson`, `hs-socks` (SimpleX forks) +- `direct-sqlcipher`, `sqlcipher-simple` (encrypted SQLite) +- `warp`, `warp-tls` (HTTP server) diff --git a/contributing/PROJECT.md b/contributing/PROJECT.md new file mode 100644 index 000000000..cda71597d --- /dev/null +++ b/contributing/PROJECT.md @@ -0,0 +1,105 @@ +# SimpleXMQ repository + +This file provides guidance on the project structure to help working with code in this repository. + +## Project Overview + +SimpleXMQ is a Haskell message broker implementing unidirectional (simplex) queues for privacy-preserving messaging. + +Key components: + +- **SimpleX Messaging Protocol**: SMP protocol definition and encodings ([code](../src/Simplex/Messaging/Protocol.hs), [transport code](../src/Simplex/Messaging/Transport.hs), [spec](../protocol/simplex-messaging.md)). +- **SMP Server**: Message broker with TLS, in-memory queues, optional persistence ([main code](../src/Simplex/Messaging/Server.hs), [all code files](../src/Simplex/Messaging/Server/), [executable](../apps/smp-server/)). For proxying SMP commands the server uses [lightweight SMP client](../src/Simplex/Messaging/Client/Agent.hs). +- **SMP Client**: Functional API with STM-based message delivery ([code](../src/Simplex/Messaging/Client.hs)). +- **SMP Agent**: High-level duplex connections via multiple simplex queues with E2E encryption ([code](../src/Simplex/Messaging/Agent.hs)). Implements Agent-to-agent protocol ([code](../src/Simplex/Messaging/Agent/Protocol.hs), [spec](../protocol/agent-protocol.md)) via intermediary agent client ([code](../src/Simplex/Messaging/Agent/Client.hs)). +- **XFTP**: SimpleX File Transfer Protocol, server and CLI client ([code](../src/Simplex/FileTransfer/), [spec](../protocol/xftp.md)). +- **XRCP**: SimpleX Remote Control Protocol ([code](`../src/Simplex/RemoteControl/`), [spec](../protocol/xrcp.md)). +- **Notifications**: Push notifications server requires PostgreSQL ([code](../src/Simplex/Messaging/Notifications), [executable](../apps/ntf-server/)). Client protocol is used for clients to communicate with the server ([code](../src/Simplex/Messaging/Notifications/Protocol.hs), [spec](../protocol/push-notifications.md)). For subscribing to SMP notifications the server uses [lightweight SMP client](../src/Simplex/Messaging/Client/Agent.hs). + +## Architecture + +For general overview see `../protocol/overview-tjr.md`. + +SMP Protocol Layers: + +``` +TLS Transport → SMP Protocol → Agent Protocol → Application protocol +``` + +XFTP Protocol Layers: + +``` +TLS Transport (HTTP2 encoding) → XFTP Protocol → Out-of-band file descriptions +``` + +## Key Patterns + +1. **Persistence**: All queue state managed via Software Transactional Memory or via PostgreSQL + - `Simplex.Messaging.Server.MsgStore.STM` - in-memory messages + - `Simplex.Messaging.Server.QueueStore.STM` - in-memory queue state + - `Simplex.Messaging.Server.MsgStore.Postgres` - message storage + - `Simplex.Messaging.Server.QueueStore.Postgres` - queue storage + +2. **Append-Only Store Log**: Optional persistence via journal for in-memory storage + - `Simplex.Messaging.Server.StoreLog` - queue creation log + - Compacted on restart + +3. **Agent Storage**: + - SQLite (default) or PostgreSQL + - Migrations in `src/Simplex/Messaging/Agent/Store/{SQLite,Postgres}/Migrations/` + +4. **Protocol Versioning**: All layers support version negotiation + - `Simplex.Messaging.Version` - version range utilities + +5. **Double Ratchet E2E**: Per-connection encryption + - `Simplex.Messaging.Crypto.Ratchet` + - SNTRUP761 post-quantum KEM (`src/Simplex/Messaging/Crypto/SNTRUP761/`) + +## Source Layout + +``` +src/Simplex/ +├── Messaging/ +│ ├── Agent.hs # Main agent (~210KB) +│ ├── Server.hs # SMP server (~130KB) +│ ├── Client.hs # Client API (~65KB) +│ ├── Protocol.hs # Protocol types (~77KB) +│ ├── Crypto.hs # E2E encryption (~52KB) +│ ├── Transport.hs # Transport encoding over TLS +│ ├── Agent/Store/ # SQLite/Postgres persistence +│ ├── Server/ # Server internals (QueueStore, MsgStore, Control) +│ └── Notifications/ # Push notification system +├── FileTransfer/ # XFTP implementation for file transfers +└── RemoteControl/ # XRCP implementation for device discovery & control +``` + +## Protocol Documentation + +- `protocol/overview-tjr.md`: SMP protocols stack overview +- `protocol/simplex-messaging.md`: SMP protocol spec (v19) +- `protocol/agent-protocol.md`: Agent protocol spec (v7) +- `protocol/xftp.md`: File transfer protocol +- `protocol/xrcp.md`: Remote control protocol +- `rfcs/`: Design RFCs for features + +## Testing + +```bash +# Run all tests +cabal test --test-show-details=streaming + +# Run specific test group (uses HSpec) +cabal test --test-option=--match="/Core tests/Encryption tests/" + +# Run single test +cabal test --test-option=--match="/SMP client agent/functional API/" +``` + +Tests require PostgreSQL running on `localhost:5432` when using `-fserver_postgres` or `-fclient_postgres`. + +Test files are in `tests/` with structure: +- `Test.hs`: Main runner +- `AgentTests/`: Agent protocol and connection tests +- `CoreTests/`: Crypto, encoding, storage tests +- `ServerTests.hs`: SMP server tests +- `XFTPServerTests.hs`: File transfer tests diff --git a/contributing/README.md b/contributing/README.md new file mode 100644 index 000000000..8333829ce --- /dev/null +++ b/contributing/README.md @@ -0,0 +1,22 @@ +# Contributing to SimpleX repositories + +## Focus on user problems + +We do not make code changes to improve code - any change must address a specific user problem or request. + +## Discuss the plans as early as possible + +Please discuss the problem you want to solve and your detailed implementation plan with the project team prior to contributing, to avoid wasted time and additional changes. Acceptance of your contribution depends on your willingness and ability to iterate the proposed contribution to achieve the required quality level, coding style, test coverage, and alignment with user requirements as they are understood by the project team. + +## Follow project structure, coding style and approaches + +./PROJECT.md has information about the structure of this `simplexmq` repository. + +./CODE.md has details about general requirements common for `simplexmq` and `simplex-chat` repositories. + +This files can be used with LLM prompts, e.g. if you use Claude Code you can create CLAUDE.md file in project root importing content from these files: + +```markdown +@contributing/PROJECT.md +@contributing/CODE.md +```