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

@@ -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

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

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

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