From 4599dafa16a42f8474ee2863c5987763e1f593eb Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 27 Jul 2024 07:50:25 +0100 Subject: [PATCH] smp client: api to send/receive data blobs directly and via proxy, tests (#1246) * smp client: api to send/receive data blobs directly and via proxy, tests * fix test --- src/Simplex/Messaging/Client.hs | 49 +++++++++++++----- src/Simplex/Messaging/Transport.hs | 13 +++-- tests/AgentTests/NotificationTests.hs | 2 +- tests/SMPProxyTests.hs | 71 ++++++++++++++++++++++++++- 4 files changed, 118 insertions(+), 17 deletions(-) diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index a8886abf7..5e5314901 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -118,6 +118,8 @@ import Control.Monad.Trans.Except import Crypto.Random (ChaChaDRG) import qualified Data.Aeson.TH as J import qualified Data.Attoparsec.ByteString.Char8 as A +import Data.Bitraversable (bimapM) +import qualified Data.ByteArray as BA import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Functor (($>)) @@ -841,16 +843,34 @@ deleteSMPDataBlob :: SMPClient -> DataPrivateAuthKey -> BlobId -> ExceptT SMPCli deleteSMPDataBlob = okSMPCommand CLR {-# INLINE deleteSMPDataBlob #-} -getSMPDataBlob :: SMPClient -> BlobId -> ExceptT SMPClientError IO EncDataBlob -getSMPDataBlob c dId = - sendSMPCommand c Nothing dId READ >>= \case - DATA encBlob -> pure encBlob +-- pk is the private key passed to the client out of band. +-- Associated public key is used as ID to retrieve data blob +getSMPDataBlob :: SMPClient -> C.PrivateKeyX25519 -> ExceptT SMPClientError IO DataBlob +getSMPDataBlob c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} pk = do + serverKey <- case thAuth thParams of + Nothing -> throwE $ PCETransportError TENoServerAuth + Just THAuthClient {serverPeerPubKey = k} -> pure k + nonce <- liftIO . atomically $ C.randomCbNonce g + let dId = BA.convert $ C.pubKeyBytes $ C.publicKey pk + sendProtocolCommand_ c (Just nonce) Nothing Nothing dId (Cmd SSender READ) >>= \case + DATA encBlob -> decryptDataBlob serverKey pk nonce encBlob r -> throwE $ unexpectedResponse r -proxyGetSMPDataBlob :: SMPClient -> ProxiedRelay -> BlobId -> ExceptT SMPClientError IO (Either ProxyClientError EncDataBlob) -proxyGetSMPDataBlob c proxiedRelay dId = proxySMPCommand c proxiedRelay Nothing dId READ $ \case - DATA encBlob -> Just encBlob - _ -> Nothing +proxyGetSMPDataBlob :: SMPClient -> ProxiedRelay -> C.PrivateKeyX25519 -> ExceptT SMPClientError IO (Either ProxyClientError DataBlob) +proxyGetSMPDataBlob c@ProtocolClient {client_ = PClient {clientCorrId = g}} proxiedRelay@ProxiedRelay {prServerKey} pk = do + nonce <- liftIO . atomically $ C.randomCbNonce g + let dId = BA.convert $ C.pubKeyBytes $ C.publicKey pk + encBlob_ <- + proxySMPCommand_ c (Just nonce) proxiedRelay Nothing dId READ $ \case + DATA encBlob -> Just encBlob + _ -> Nothing + bimapM pure (decryptDataBlob prServerKey pk nonce) encBlob_ + +decryptDataBlob :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> ByteString -> ExceptT (ProtocolClientError ErrorType) IO DataBlob +decryptDataBlob serverKey pk nonce encBlob = do + let ss = C.dh' serverKey pk + blobStr <- liftEitherWith PCECryptoError $ C.cbDecrypt ss nonce encBlob + liftEitherWith (const $ PCEResponseError BLOCK) $ smpDecode blobStr -- send PRXY :: SMPServer -> Maybe BasicAuth -> Command Sender -- receives PKEY :: SessionId -> X.CertificateChain -> X.SignedExact X.PubKey -> BrokerMsg @@ -905,6 +925,9 @@ instance StrEncoding ProxyClientError where "SYNTAX" -> ProxyResponseError <$> _strP _ -> fail "bad ProxyClientError" +proxySMPCommand :: SMPClient -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> Command 'Sender -> (BrokerMsg -> Maybe r) -> ExceptT SMPClientError IO (Either ProxyClientError r) +proxySMPCommand c = proxySMPCommand_ c Nothing + -- consider how to process slow responses - is it handled somehow locally or delegated to the caller -- this method is used in the client -- sends PFWD :: C.PublicKeyX25519 -> EncTransmission -> Command Sender @@ -932,23 +955,25 @@ instance StrEncoding ProxyClientError where -- - other errors from the client running on proxy and connected to relay in PREProxiedRelayError -- This function proxies Sender commands that return OK or ERR -proxySMPCommand :: +proxySMPCommand_ :: SMPClient -> + -- optional correlation ID/nonce for the sending client + Maybe C.CbNonce -> -- proxy session from PKEY ProxiedRelay -> - -- message to deliver + -- command to deliver Maybe SndPrivateAuthKey -> SenderId -> Command 'Sender -> (BrokerMsg -> Maybe r) -> ExceptT SMPClientError IO (Either ProxyClientError r) -proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v _ serverKey) spKey sId command toResult = do +proxySMPCommand_ c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} nonce_ (ProxiedRelay sessionId v _ serverKey) spKey sId command toResult = do -- prepare params let serverThAuth = (\ta -> ta {serverPeerPubKey = serverKey}) <$> thAuth proxyThParams serverThParams = smpTHParamsSetVersion v proxyThParams {sessionId, thAuth = serverThAuth} (cmdPubKey, cmdPrivKey) <- liftIO . atomically $ C.generateKeyPair @'C.X25519 g let cmdSecret = C.dh' serverKey cmdPrivKey - nonce@(C.CbNonce corrId) <- liftIO . atomically $ C.randomCbNonce g + nonce@(C.CbNonce corrId) <- liftIO $ maybe (atomically $ C.randomCbNonce g) pure nonce_ -- encode let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender command) auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth spKey nonce tForAuth diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index d7f81f563..9d6923063 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -47,6 +47,7 @@ module Simplex.Messaging.Transport authCmdsSMPVersion, sendingProxySMPVersion, sndAuthKeySMPVersion, + dataBlobSMPVersion, simplexMQVersion, smpBlockSize, TransportConfig (..), @@ -130,6 +131,9 @@ smpBlockSize = 16384 -- 5 - basic auth for SMP servers (11/12/2022) -- 6 - allow creating queues without subscribing (9/10/2023) -- 7 - support authenticated encryption to verify senders' commands, imply but do NOT send session ID in signed part (4/30/2024) +-- 8 - forwarding proxy protecting IP addresses and sessions of command senders (5/14/2024) +-- 9 - securing message queue by sender (SKEY command) for faster connection handshake (6/30/2024) +-- 10 - storing data blobs on SMP servers for short invitation links (7/25/2024) data SMPVersion @@ -160,14 +164,17 @@ sendingProxySMPVersion = VersionSMP 8 sndAuthKeySMPVersion :: VersionSMP sndAuthKeySMPVersion = VersionSMP 9 +dataBlobSMPVersion :: VersionSMP +dataBlobSMPVersion = VersionSMP 10 + currentClientSMPRelayVersion :: VersionSMP -currentClientSMPRelayVersion = VersionSMP 9 +currentClientSMPRelayVersion = VersionSMP 10 legacyServerSMPRelayVersion :: VersionSMP legacyServerSMPRelayVersion = VersionSMP 6 currentServerSMPRelayVersion :: VersionSMP -currentServerSMPRelayVersion = VersionSMP 9 +currentServerSMPRelayVersion = VersionSMP 10 -- Max SMP protocol version to be used in e2e encrypted -- connection between client and server, as defined by SMP proxy. @@ -175,7 +182,7 @@ currentServerSMPRelayVersion = VersionSMP 9 -- to prevent client version fingerprinting by the -- destination relays when clients upgrade at different times. proxiedSMPRelayVersion :: VersionSMP -proxiedSMPRelayVersion = VersionSMP 9 +proxiedSMPRelayVersion = VersionSMP 10 -- minimal supported protocol version is 4 -- TODO remove code that supports sending commands without batching diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index cc79faeca..2f6b579bb 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -164,7 +164,7 @@ testNtfMatrix t runTest = do it "curr servers; curr clients" $ runNtfTestCfg t 1 cfg ntfServerCfg agentCfg agentCfg runTest it "curr servers; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest it "prev servers; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest - it "prev servers; curr clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest + it "prev servers; curr clients" $ runNtfTestCfg t 1 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest -- servers can be upgraded in any order it "servers: curr SMP, prev NTF; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest it "servers: prev SMP, curr NTF; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index 8044d23f7..a43d98669 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -19,6 +19,9 @@ import Control.Concurrent (ThreadId, threadDelay) import Control.Logger.Simple import Control.Monad (forM, forM_, forever, replicateM_) import Control.Monad.Trans.Except (ExceptT, runExceptT) +import Crypto.Hash (SHA512) +import qualified Crypto.KDF.HKDF as H +import qualified Data.ByteArray as BA import Data.ByteString.Char8 (ByteString) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as L @@ -34,7 +37,7 @@ import Simplex.Messaging.Client import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOn) import qualified Simplex.Messaging.Crypto.Ratchet as CR -import Simplex.Messaging.Protocol (EncRcvMsgBody (..), MsgBody, RcvMessage (..), SubscriptionMode (..), maxMessageLength, noMsgFlags) +import Simplex.Messaging.Protocol (DataBlob (..), EncRcvMsgBody (..), MsgBody, RcvMessage (..), SubscriptionMode (..), e2eEncConfirmationLength, maxMessageLength, noMsgFlags) import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.Server.Env.STM (ServerConfig (..)) import Simplex.Messaging.Transport @@ -133,6 +136,25 @@ smpProxyTests = do xdescribe "stress test 10k" $ do let deliver nAgents nMsgs = agentDeliverMessagesViaProxyConc (replicate nAgents [srv1]) (map bshow [1 :: Int .. nMsgs]) it "25 agents, 300 pairs, 17 messages" . oneServer . withNumCapabilities 4 $ deliver 25 17 + describe "receive data blobs via SMP proxy" $ do + let srv1 = SMPServer testHost testPort testKeyHash + srv2 = SMPServer testHost testPort2 testKeyHash + describe "client API" $ do + describe "one server" $ do + it "deliver via proxy" . oneServer $ do + receiveBlobViaProxy srv1 srv1 C.SEd448 "hello" + describe "two servers" $ do + let proxyServ = srv1 + relayServ = srv2 + blob <- runIO $ atomically . C.randomBytes (e2eEncConfirmationLength - 2) =<< C.newRandom + it "deliver via proxy" . twoServersFirstProxy $ + receiveBlobViaProxy proxyServ relayServ C.SEd448 "hello" + it "max blob size, Ed448 keys" . twoServersFirstProxy $ + receiveBlobViaProxy proxyServ relayServ C.SEd448 blob + it "max blob size, Ed25519 keys" . twoServersFirstProxy $ + receiveBlobViaProxy proxyServ relayServ C.SEd25519 blob + it "max blob size, X25519 keys" . twoServersFirstProxy $ + receiveBlobViaProxy proxyServ relayServ C.SX25519 blob where oneServer = withSmpServerConfigOn (transport @TLS) proxyCfg {msgQueueQuota = 128} testPort . const twoServers = twoServers_ proxyCfg proxyCfg @@ -404,6 +426,53 @@ agentViaProxyRetryNoSession = do withServer2 = withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just testStoreLogFile2, storeMsgsFile = Just testStoreMsgsFile2} testPort2 servers srv = (initAgentServersProxy SPMAlways SPFProhibit) {smp = userServers [srv]} +receiveBlobViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => SMPServer -> SMPServer -> C.SAlgorithm a -> ByteString -> IO () +receiveBlobViaProxy proxyServ relayServ alg origData = do + g <- C.newRandom + -- proxy client + pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig Nothing (\_ -> pure ()) + pc <- either (fail . show) pure pc' + THAuthClient {} <- maybe (fail "getProtocolClient returned no thAuth") pure $ thAuth $ thParams pc + -- relay client + rc' <- getProtocolClient g (2, relayServ, Nothing) defaultSMPClientConfig Nothing (\_ -> pure ()) + rc <- either (fail . show) pure rc' + -- prepare blob + -- k: ID to retrive blob. + -- pk: part of the link sent to the accepting party (Sender role), + -- also key material for HKDF to derive key to e2e encrypt blob. + -- hash(k): ID used to store blob + -- (k, pk): used to agree additional server-to-client encryption when retrieving blob, + -- using DH with server session keys. + (C.PublicKeyX25519 k, pk'@(C.PrivateKeyX25519 pk _)) <- atomically $ C.generateKeyPair @'C.X25519 g + blobKeys@(_, blobPKey) <- atomically $ C.generateAuthKeyPair alg g + let kBytes = BA.convert k :: ByteString -- blob ID for "sender" (blob recipient) + rBlobId = C.sha256Hash kBytes + pkBytes = BA.convert pk :: ByteString + ikm = pkBytes + salt = "" :: ByteString + info = "SimpleXDataBlob" :: ByteString + prk = H.extract salt ikm :: H.PRK SHA512 + skBytes = H.expand prk info 32 + dataNonce <- atomically $ C.randomCbNonce g + Right sk <- pure $ C.sbKey skBytes + -- store blob + Right dataBody <- pure $ C.sbEncrypt sk dataNonce origData e2eEncConfirmationLength + let blob = DataBlob {dataNonce, dataBody} + runRight_ $ do + createSMPDataBlob rc blobKeys rBlobId blob + -- retrive blob directly + blob1@DataBlob {dataNonce = dataNonce1, dataBody = body1} <- getSMPDataBlob rc pk' + liftIO $ blob1 `shouldBe` blob + liftIO $ C.sbDecrypt sk dataNonce1 body1 `shouldBe` Right origData + -- retrive blob via proxy + sess <- connectSMPProxiedRelay pc relayServ (Just "correct") + Right blob2 <- proxyGetSMPDataBlob pc sess pk' + liftIO $ blob2 `shouldBe` blob + -- delete blob + deleteSMPDataBlob rc blobPKey rBlobId + liftIO $ runExceptT (getSMPDataBlob rc pk') `shouldReturn` Left (PCEProtocolError SMP.AUTH) + liftIO $ runExceptT (proxyGetSMPDataBlob pc sess pk') `shouldReturn` Left (PCEProtocolError SMP.AUTH) + testNoProxy :: IO () testNoProxy = do withSmpServerConfigOn (transport @TLS) cfg testPort2 $ \_ -> do