smp server: key-value storage (for short invitation links) (#1206)

* rfc: short invitation links

* shorter

* types

* server implementation, client functions

* test

* update rfc

* test name

rfcs/2024-06-21-short-links.md

@@ -0,0 +1,124 @@
+# Short invitation links
+
+## Problem
+
+Long links look scary and unsafe for many users. While this is a perceived problem, rather than a real one, it hurts adoption.
+
+What is worse, long links do not fit in profile descriptions of other social networks where people might want to advertize their contact addresses.
+
+The current link size limitation is also the reason for not including PQ KEM keys into invitation links and addresses, postponing the moment when PQ-resistant encryption kicks in - if we include PQ KEM key into the link, the QR code will not be scannable.
+
+Additionally, if we store short links, they can also include chat preferences and public profile data.
+
+## Solution
+
+MITM-resistant link shortening.
+
+Instead of generating the random address that would resolve into the link - doing so would create the possibility of MITM by the server hosting this link - we can use private key as the link ID that will be passed to the accepting party, and the hash of the public key as ID for the server - the accepting party would present this key itself as ID and it will also be used for server to client encryption (see Protocol below). HKDF will be used to derive symmetric key from private key and used in secret_box together with random nonce (to allow replacing data with the same key but with a different nonce - nonce will be sent to the server too). secret_box construction is authenticated encryption, so it would protect from MITM.
+
+The proposed syntax:
+
+```abnf
+shortConnectionRequest = connectionScheme "/" connReqType "#/" smpServer "/" linkHash
+connReqType = %s"invitation" / %s"contact"
+connectionScheme = (%s"https://" clientAppServer) / %s"simplex:"
+clientAppServer = hostname [ ":" port ]
+  ; client app server, e.g. simplex.chat
+smpServer = serverIdentity "@" srvHosts [":" port] ; no smp:// prefix, no escaping
+srvHosts = <hostname> ["," srvHosts] ; RFC1123, RFC5891
+linkHash = <base64url encoded SHA256 or SHA512 hash of the original link>
+```
+
+If SMP server supports pages, its name can be used as clientAppServer, without repeating it after #, for a shorter link.
+
+Example link:
+
+```
+https://simplex.chat/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im/abcdefghij0123456789abcdefghij0123456789abc=
+```
+
+This link has the length of ~136 characters (256 bits), which is shorter than the full contact address (~310 characters) and much shorter than invitation links (~528 characters) even without post-quantum keys added to them.
+
+This size can be further reduced by
+- use server domain in the link.
+- do not include onion address, as the connection happens via proxy anyway, if it's untrusted server.
+- not pinning server TLS certificate - the downside here is that while the attack that compromises TLS will not be able to substitute the link (because it's hash will not match), it will be able to intercept and to block it.
+- using shorter hash, e.g. SHA128 - reducing the collision resistance.
+
+If the server is known, the client could use it's hash and onion address, otherwise it could trust the proxy to use any existing session with the same hostname or to accept the risk of interception - given that there is no risk of substitution.
+
+With the first two of these "improvements" the link could be ~122 characters:
+
+```
+https://smp8.simplex.im/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@/abcdefghij0123456789abcdefghij0123456789abc
+```
+
+If onion address is preserved the link will be ~184 characters (won't fit in Twitter 160 characters bio):
+
+```
+https://smp8.simplex.im/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion/abcdefghij0123456789abcdefghij0123456789abc
+```
+
+If we implement it, the request to resolve the link would be made via proxied SMP command (to avoid the direct connection between the client and the recipient's server).
+
+Pros:
+- a bit shorter link.
+- possibility to include post-quantum keys into the full link keeping the same shortened link size.
+- possibility to include chat profile of contact or group, and preferences, for a much better connection experience, and to show this information when the link sent in the conversation (clients can resolve them automatically, without connecting - it can be resolved by the sending clients).
+- server will not have access to the link.
+
+Cons:
+- protocol complexity.
+- observers can access the link content, so for 1-time invitation we should only include permissions and not profile.
+
+Pros are a huge improvement of UX of connecting both within and from outside of the app (e.g., link can be resolved even before creating chat profile, as part of the onboarding).
+
+## Protocol
+
+To support short links, the SMP servers would provide a simple key-value store enabled by three additional commands: `WRT`, `CLR` and `READ`
+
+`WRT` command is used to store and to update values in the store. The size of the value is limited by the same size as sent messages (or, possibly, smaller - as connection information size used in confirmation messages) - the clients would use this fixed size irrespective of the content. `WRT` command will be sent with the data blob ID in the transaction entityId field, public authorization key used to authorize `WRT` and `CLR` commands (subsequent WRT commands to the existing key must use the same key), and the data blob.
+
+`CLR` command must use with the same entity ID and must be authorized by the same key.
+
+`READ` command must use the ID which hash would be equal of the ID used to create the data blob, and this ID would also be used as public authorization
+
+## Algorithm to store and to retrieve data blob.
+
+**Store data blob**
+
+- the data blob owner generates X25519 key pair: `(k, pk)`.
+- private key `pk` will be included in the short link shared with the other party (only base64url encoded key bytes, not X509 encoding).
+- `HKDF(pk)` will be used to encrypt the link data with secret_box before storing it on the server.
+- the hash of public key `sha256(k)` will be used as ID by the owner to store and to remove the data blob (`WRT` and `CLR` commands).
+
+**Retrieve data blob**
+
+- the sender uses the public key `k` derived from the private key `pk` included in the link as entity ID to retrieve data blob (the server will compute the ID used by the owner as `sha256(k)` and will be able to look it up). This provides the quality that the traffic of the parties has no shared IDs inside TLS. It also means that unlike message queue creation, the ID to retrieve the blob was never sent to the blob creator, and also is not known to the server in advance (the second part is only an observation, in itself it does not increase security, as server has access to an encrypted blob anyway).
+- note that the sender does not authorize the request to retrieve the blob, as it would not increase security unless a different key is used to authorize, and adding a key would increase link size.
+- server session keys with the sender will be `(sk, spk)`, where `sk` is public key shared with the sender during session handshake, and `spk` is the private key known only to the server.
+- this public key `k` will also be combined with server session key `spk` using `dh(k, spk)` to encrypt the response, so that there is no ciphertext in common in sent and received traffic for these blobs. Correlation ID will be used as a nonce for this encryption.
+- having received the blob, the client can now decrypt it using secret_box with `HKDF(pk)`.
+
+Using the same key as ID for the request, and also to additionally encrypt the response allows to use a single key in the link, without increasing the link size.
+
+## Threat model
+
+**Compromised SMP server**
+
+can:
+- delete link data.
+- hide link selectively from some requests.
+
+cannot:
+- undetectably replace link data.
+- access unencrypted link data, whether it was or was not accessed by the accepting party.
+- observe IP addresses of the users accessing link data.
+
+**Passive observer who observed short link**:
+
+can:
+- access original unencrypted link data
+
+cannot:
+- replace or delete the link data

simplexmq.cabal

@@ -167,6 +167,7 @@ library
       Simplex.Messaging.Server
       Simplex.Messaging.Server.CLI
       Simplex.Messaging.Server.Control
+      Simplex.Messaging.Server.DataStore
       Simplex.Messaging.Server.Env.STM
       Simplex.Messaging.Server.Expiration
       Simplex.Messaging.Server.Information

src/Simplex/Messaging/Client.hs

@@ -58,6 +58,10 @@ module Simplex.Messaging.Client
     suspendSMPQueue,
     deleteSMPQueue,
     deleteSMPQueues,
+    createSMPDataBlob,
+    deleteSMPDataBlob,
+    getSMPDataBlob,
+    proxyGetSMPDataBlob,
     connectSMPProxiedRelay,
     proxySMPMessage,
     forwardSMPTransmission,
@@ -748,9 +752,14 @@ secureSndSMPQueue c spKey sId senderKey = okSMPCommand (SKEY senderKey) c spKey
 {-# INLINE secureSndSMPQueue #-}
 
 proxySecureSndSMPQueue :: SMPClient -> ProxiedRelay -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySecureSndSMPQueue c proxiedRelay spKey sId senderKey = proxySMPCommand c proxiedRelay (Just spKey) sId (SKEY senderKey)
+proxySecureSndSMPQueue c proxiedRelay spKey sId senderKey = proxySMPCommand c proxiedRelay (Just spKey) sId (SKEY senderKey) okResult
 {-# INLINE proxySecureSndSMPQueue #-}
 
+okResult :: BrokerMsg -> Maybe ()
+okResult = \case
+  OK -> Just ()
+  _ -> Nothing
+
 -- | Enable notifications for the queue for push notifications server.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command
@@ -792,7 +801,7 @@ sendSMPMessage c spKey sId flags msg =
     r -> throwE $ unexpectedResponse r
 
 proxySMPMessage :: SMPClient -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> MsgFlags -> MsgBody -> ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySMPMessage c proxiedRelay spKey sId flags msg = proxySMPCommand c proxiedRelay spKey sId (SEND flags msg)
+proxySMPMessage c proxiedRelay spKey sId flags msg = proxySMPCommand c proxiedRelay spKey sId (SEND flags msg) okResult
 
 -- | Acknowledge message delivery (server deletes the message).
 --
@@ -824,6 +833,25 @@ deleteSMPQueues :: SMPClient -> NonEmpty (RcvPrivateAuthKey, RecipientId) -> IO
 deleteSMPQueues = okSMPCommands DEL
 {-# INLINE deleteSMPQueues #-}
 
+createSMPDataBlob :: SMPClient -> C.AAuthKeyPair -> BlobId -> DataBlob -> ExceptT SMPClientError IO ()
+createSMPDataBlob c (dKey, dpKey) dId blob = okSMPCommand (WRT dKey blob) c dpKey dId
+{-# INLINE createSMPDataBlob #-}
+
+deleteSMPDataBlob :: SMPClient -> DataPrivateAuthKey -> BlobId -> ExceptT SMPClientError IO ()
+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
+    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
+
 -- send PRXY :: SMPServer -> Maybe BasicAuth -> Command Sender
 -- receives PKEY :: SessionId -> X.CertificateChain -> X.SignedExact X.PubKey -> BrokerMsg
 connectSMPProxiedRelay :: SMPClient -> SMPServer -> Maybe BasicAuth -> ExceptT SMPClientError IO ProxiedRelay
@@ -912,8 +940,9 @@ proxySMPCommand ::
   Maybe SndPrivateAuthKey ->
   SenderId ->
   Command 'Sender ->
-  ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v _ serverKey) spKey sId command = do
+  (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
   -- prepare params
   let serverThAuth = (\ta -> ta {serverPeerPubKey = serverKey}) <$> thAuth proxyThParams
       serverThParams = smpTHParamsSetVersion v proxyThParams {sessionId, thAuth = serverThAuth}
@@ -939,9 +968,11 @@ proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
         case tParse serverThParams t' of
           t'' :| [] -> case tDecodeParseValidate serverThParams t'' of
             (_auth, _signed, (_c, _e, cmd)) -> case cmd of
-              Right OK -> pure $ Right ()
-              Right (ERR e) -> throwE $ PCEProtocolError e -- this is the error from the destination relay
-              Right r' -> throwE $ unexpectedResponse r'
+              Right r' -> case toResult r' of
+                Just r'' -> pure $ Right r''
+                Nothing -> case r' of
+                  ERR e -> throwE $ PCEProtocolError e -- this is the error from the destination relay
+                  _ -> throwE $ unexpectedResponse r'
               Left e -> throwE $ PCEResponseError e
           _ -> throwE $ PCETransportError TEBadBlock
       ERR e -> pure . Left $ ProxyProtocolError e -- this will not happen, this error is returned via Left

src/Simplex/Messaging/Protocol.hs

@@ -101,6 +101,7 @@ module Simplex.Messaging.Protocol
     CorrId (..),
     EntityId,
     QueueId,
+    BlobId,
     RecipientId,
     SenderId,
     NotifierId,
@@ -114,6 +115,8 @@ module Simplex.Messaging.Protocol
     NtfPublicAuthKey,
     RcvNtfPublicDhKey,
     RcvNtfDhSecret,
+    DataPrivateAuthKey,
+    DataPublicAuthKey,
     Message (..),
     RcvMessage (..),
     MsgId,
@@ -133,6 +136,8 @@ module Simplex.Messaging.Protocol
     FwdResponse (..),
     FwdTransmission (..),
     MsgFlags (..),
+    DataBlob (..),
+    EncDataBlob,
     initialSMPClientVersion,
     currentSMPClientVersion,
     userProtocol,
@@ -374,6 +379,8 @@ type NotifierId = QueueId
 -- | SMP queue ID on the server.
 type QueueId = EntityId
 
+type BlobId = EntityId
+
 type EntityId = ByteString
 
 -- | Parameterized type for SMP protocol commands from all clients.
@@ -395,6 +402,10 @@ data Command (p :: Party) where
   OFF :: Command Recipient
   DEL :: Command Recipient
   QUE :: Command Recipient
+  -- Data storage commands
+  WRT :: DataPublicAuthKey -> DataBlob -> Command Recipient
+  CLR :: Command Recipient
+  READ :: Command Sender
   -- SMP sender commands
   SKEY :: SndPublicAuthKey -> Command Sender
   -- SEND v1 has to be supported for encoding/decoding
@@ -403,6 +414,7 @@ data Command (p :: Party) where
   PING :: Command Sender
   -- SMP notification subscriber commands
   NSUB :: Command Notifier
+  -- Proxy commands
   PRXY :: SMPServer -> Maybe BasicAuth -> Command ProxiedClient -- request a relay server connection by URI
   -- Transmission to proxy:
   -- - entity ID: ID of the session with relay returned in PKEY (response to PRXY)
@@ -476,6 +488,7 @@ data BrokerMsg where
   PRES :: EncResponse -> BrokerMsg -- proxy to client
   END :: BrokerMsg
   INFO :: QueueInfo -> BrokerMsg
+  DATA :: EncDataBlob -> BrokerMsg
   OK :: BrokerMsg
   ERR :: ErrorType -> BrokerMsg
   PONG :: BrokerMsg
@@ -673,6 +686,9 @@ data CommandTag (p :: Party) where
   OFF_ :: CommandTag Recipient
   DEL_ :: CommandTag Recipient
   QUE_ :: CommandTag Recipient
+  WRT_ :: CommandTag Recipient
+  CLR_ :: CommandTag Recipient
+  READ_ :: CommandTag Sender
   SKEY_ :: CommandTag Sender
   SEND_ :: CommandTag Sender
   PING_ :: CommandTag Sender
@@ -697,6 +713,7 @@ data BrokerMsgTag
   | PRES_
   | END_
   | INFO_
+  | DATA_
   | OK_
   | ERR_
   | PONG_
@@ -722,6 +739,9 @@ instance PartyI p => Encoding (CommandTag p) where
     OFF_ -> "OFF"
     DEL_ -> "DEL"
     QUE_ -> "QUE"
+    WRT_ -> "WRT"
+    CLR_ -> "CLR"
+    READ_ -> "READ"
     SKEY_ -> "SKEY"
     SEND_ -> "SEND"
     PING_ -> "PING"
@@ -743,6 +763,9 @@ instance ProtocolMsgTag CmdTag where
     "OFF" -> Just $ CT SRecipient OFF_
     "DEL" -> Just $ CT SRecipient DEL_
     "QUE" -> Just $ CT SRecipient QUE_
+    "WRT" -> Just $ CT SRecipient WRT_
+    "CLR" -> Just $ CT SRecipient CLR_
+    "READ" -> Just $ CT SSender READ_
     "SKEY" -> Just $ CT SSender SKEY_
     "SEND" -> Just $ CT SSender SEND_
     "PING" -> Just $ CT SSender PING_
@@ -770,6 +793,7 @@ instance Encoding BrokerMsgTag where
     PRES_ -> "PRES"
     END_ -> "END"
     INFO_ -> "INFO"
+    DATA_ -> "DATA"
     OK_ -> "OK"
     ERR_ -> "ERR"
     PONG_ -> "PONG"
@@ -786,6 +810,7 @@ instance ProtocolMsgTag BrokerMsgTag where
     "PRES" -> Just PRES_
     "END" -> Just END_
     "INFO" -> Just INFO_
+    "DATA" -> Just DATA_
     "OK" -> Just OK_
     "ERR" -> Just ERR_
     "PONG" -> Just PONG_
@@ -1157,12 +1182,38 @@ type RcvNtfPublicDhKey = C.PublicKeyX25519
 -- | DH Secret used to encrypt notification metadata from server to recipient
 type RcvNtfDhSecret = C.DhSecretX25519
 
+-- | private key to authorize owner access to data blobs
+type DataPrivateAuthKey = C.APrivateAuthKey
+
+-- | public key to authorize owner access to data blobs
+type DataPublicAuthKey = C.APublicAuthKey
+
 -- | SMP message server ID.
 type MsgId = ByteString
 
 -- | SMP message body.
 type MsgBody = ByteString
 
+data DataBlob = DataBlob
+  { dataNonce :: C.CbNonce,
+    dataBody :: ByteString
+  }
+  deriving (Eq, Show)
+
+instance Encoding DataBlob where
+  smpEncode DataBlob {dataNonce, dataBody} = smpEncode (dataNonce, Tail dataBody)
+  smpP = do
+    (dataNonce, Tail dataBody) <- smpP
+    pure DataBlob {dataNonce, dataBody}
+
+instance StrEncoding DataBlob where
+  strEncode DataBlob {dataNonce, dataBody} = strEncode (dataNonce, dataBody)
+  strP = do
+    (dataNonce, dataBody) <- strP
+    pure DataBlob {dataNonce, dataBody}
+
+type EncDataBlob = ByteString
+
 data ProtocolErrorType = PECmdSyntax | PECmdUnknown | PESession | PEBlock
 
 -- | Type for protocol errors.
@@ -1307,6 +1358,9 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
     OFF -> e OFF_
     DEL -> e DEL_
     QUE -> e QUE_
+    WRT k blob -> e (WRT_, ' ', k, blob)
+    CLR -> e CLR_
+    READ -> e READ_
     SKEY k -> e (SKEY_, ' ', k)
     SEND flags msg -> e (SEND_, ' ', flags, ' ', Tail msg)
     PING -> e PING_
@@ -1336,14 +1390,12 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
     SKEY _
       | isNothing auth || B.null entId -> Left $ CMD NO_AUTH
       | otherwise -> Right cmd
+    READ -> entityNoAuthCmd
     PING -> noAuthCmd
     PRXY {} -> noAuthCmd
-    PFWD {}
-      | B.null entId -> Left $ CMD NO_ENTITY
-      | isNothing auth -> Right cmd
-      | otherwise -> Left $ CMD HAS_AUTH
+    PFWD {} -> entityNoAuthCmd
     RFWD _ -> noAuthCmd
-    -- other client commands must have both signature and queue ID
+    -- other client commands must have both signature and entity ID
     _
       | isNothing auth || B.null entId -> Left $ CMD NO_AUTH
       | otherwise -> Right cmd
@@ -1353,6 +1405,11 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
       noAuthCmd
         | isNothing auth && B.null entId = Right cmd
         | otherwise = Left $ CMD HAS_AUTH
+      entityNoAuthCmd :: Either ErrorType (Command p)
+      entityNoAuthCmd
+        | B.null entId = Left $ CMD NO_ENTITY
+        | isJust auth = Left $ CMD HAS_AUTH
+        | otherwise = Right cmd
 
 instance ProtocolEncoding SMPVersion ErrorType Cmd where
   type Tag Cmd = CmdTag
@@ -1378,10 +1435,13 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
         OFF_ -> pure OFF
         DEL_ -> pure DEL
         QUE_ -> pure QUE
+        WRT_ -> WRT <$> _smpP <*> smpP
+        CLR_ -> pure CLR
     CT SSender tag ->
       Cmd SSender <$> case tag of
         SKEY_ -> SKEY <$> _smpP
         SEND_ -> SEND <$> _smpP <*> (unTail <$> _smpP)
+        READ_ -> pure READ
         PING_ -> pure PING
         RFWD_ -> RFWD <$> (EncFwdTransmission . unTail <$> _smpP)
     CT SProxiedClient tag ->
@@ -1412,6 +1472,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     PRES (EncResponse encBlock) -> e (PRES_, ' ', Tail encBlock)
     END -> e END_
     INFO info -> e (INFO_, ' ', info)
+    DATA body -> e (DATA_, ' ', Tail body)
     OK -> e OK_
     ERR err -> e (ERR_, ' ', err)
     PONG -> e PONG_
@@ -1437,6 +1498,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     PRES_ -> PRES <$> (EncResponse . unTail <$> _smpP)
     END_ -> pure END
     INFO_ -> INFO <$> _smpP
+    DATA_ -> DATA . unTail <$> _smpP
     OK_ -> pure OK
     ERR_ -> ERR <$> _smpP
     PONG_ -> pure PONG

src/Simplex/Messaging/Server.hs

@@ -43,6 +43,8 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Control.Monad.Trans.Except
+import qualified Crypto.PubKey.Curve25519 as X25519
+import qualified Crypto.Error as CE
 import Crypto.Random
 import Control.Monad.STM (retry)
 import Data.Bifunctor (first)
@@ -78,6 +80,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Control
+import Simplex.Messaging.Server.DataStore
 import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
@@ -631,14 +634,13 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
     write sndQ errs
     write rcvQ cmds
   where
-    cmdAction :: ServerStats -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
+    cmdAction :: ServerStats -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (VerificationResult, Transmission Cmd))
     cmdAction stats (tAuth, authorized, (corrId, entId, cmdOrError)) =
       case cmdOrError of
         Left e -> pure $ Left (corrId, entId, ERR e)
         Right cmd -> verified =<< verifyTransmission ((,C.cbNonce (bs corrId)) <$> thAuth) tAuth authorized entId cmd
           where
             verified = \case
-              VRVerified qr -> pure $ Right (qr, (corrId, entId, cmd))
               VRFailed -> do
                 case cmd of
                   Cmd _ SEND {} -> incStat $ msgSentAuth stats
@@ -646,6 +648,7 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
                   Cmd _ GET -> incStat $ msgGetAuth stats
                   _ -> pure ()
                 pure $ Left (corrId, entId, ERR AUTH)
+              vRes -> pure $ Right (vRes, (corrId, entId, cmd))
     write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
 
 send :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO ()
@@ -697,8 +700,6 @@ disconnectTransport THandle {connection, params = THandleParams {sessionId}} rcv
       ts <- max <$> readTVarIO rcvActiveAt <*> readTVarIO sndActiveAt
       if systemSeconds ts < old then closeConnection connection else loop
 
-data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
-
 -- This function verifies queue command authorization, with the objective to have constant time between the three AUTH error scenarios:
 -- - the queue and party key exist, and the provided authorization has type matching queue key, but it is made with the different key.
 -- - the queue and party key exist, but the provided authorization has incorrect type.
@@ -706,13 +707,16 @@ data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
 -- In all cases, the time of the verification should depend only on the provided authorization type,
 -- a dummy key is used to run verification in the last two cases, and failure is returned irrespective of the result.
 verifyTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> QueueId -> Cmd -> M VerificationResult
-verifyTransmission auth_ tAuth authorized queueId cmd =
+verifyTransmission auth_ tAuth authorized entId cmd =
   case cmd of
     Cmd SRecipient (NEW k _ _ _ _) -> pure $ Nothing `verifiedWith` k
+    Cmd SRecipient (WRT k _) -> (\d -> d `verifiedData` (verify k && maybe True ((k ==) . dataKey) d)) <$> getData entId
+    Cmd SRecipient CLR -> maybe dummyVerify (\d -> Just d `verifiedData` verify (dataKey d)) <$> getData entId
     Cmd SRecipient _ -> verifyQueue (\q -> Just q `verifiedWith` recipientKey q) <$> get SRecipient
     -- SEND will be accepted without authorization before the queue is secured with KEY or SKEY command
     Cmd SSender (SKEY k) -> verifyQueue (\q -> Just q `verifiedWith` k) <$> get SSender
     Cmd SSender SEND {} -> verifyQueue (\q -> Just q `verified` maybe (isNothing tAuth) verify (senderKey q)) <$> get SSender
+    Cmd SSender READ -> maybe VRFailed (VRVerifiedData . Just) <$> getData (C.sha256Hash entId)
     Cmd SSender PING -> pure $ VRVerified Nothing
     Cmd SSender RFWD {} -> pure $ VRVerified Nothing
     -- NSUB will not be accepted without authorization
@@ -725,10 +729,13 @@ verifyTransmission auth_ tAuth authorized queueId cmd =
     verifyQueue = either (const dummyVerify)
     verified q cond = if cond then VRVerified q else VRFailed
     verifiedWith q k = q `verified` verify k
+    verifiedData d cond = if cond then VRVerifiedData d else VRFailed
     get :: DirectParty p => SParty p -> M (Either ErrorType QueueRec)
     get party = do
       st <- asks queueStore
-      atomically $ getQueue st party queueId
+      atomically $ getQueue st party entId
+    getData :: BlobId -> M (Maybe DataRec)
+    getData blobId = atomically . TM.lookup blobId =<< asks dataStore
 
 verifyCmdAuthorization :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> C.APublicAuthKey -> Bool
 verifyCmdAuthorization auth_ tAuth authorized key = maybe False (verify key) tAuth
@@ -873,16 +880,15 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
     mkIncProxyStats ps psOwn own sel = do
       incStat $ sel ps
       when own $ incStat $ sel psOwn
-    processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
-    processCommand (qr_, (corrId, entId, cmd)) = case cmd of
+    processCommand :: (VerificationResult, Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
+    processCommand (vRes, (corrId, entId, cmd)) = case cmd of
       Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command)
       Cmd SSender command -> Just <$> case command of
-        SKEY sKey -> (corrId,entId,) <$> case qr_ of
-          Just QueueRec {sndSecure, recipientId}
-            | sndSecure -> secureQueue_ "SKEY" recipientId sKey
-            | otherwise -> pure $ ERR AUTH
-          Nothing -> pure $ ERR INTERNAL
+        SKEY sKey ->
+          withQueue $ \QueueRec {sndSecure, recipientId} ->
+            (corrId,entId,) <$> if sndSecure then secureQueue_ "SKEY" recipientId sKey else pure $ ERR AUTH
         SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
+        READ -> getDataBlob
         PING -> pure (corrId, "", PONG)
         RFWD encBlock -> (corrId, "",) <$> processForwardedCommand encBlock
       Cmd SNotifier NSUB -> Just <$> subscribeNotifications
@@ -901,14 +907,16 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           SUB -> withQueue (`subscribeQueue` entId)
           GET -> withQueue getMessage
           ACK msgId -> withQueue (`acknowledgeMsg` msgId)
-          KEY sKey -> (corrId,entId,) <$> case qr_ of
-            Just QueueRec {recipientId} -> secureQueue_ "KEY" recipientId sKey
-            Nothing -> pure $ ERR INTERNAL
+          KEY sKey ->
+            withQueue $ \QueueRec {recipientId} ->
+              (corrId,entId,) <$> secureQueue_ "KEY" recipientId sKey
           NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
           NDEL -> deleteQueueNotifier_ st
           OFF -> suspendQueue_ st
           DEL -> delQueueAndMsgs st
           QUE -> withQueue getQueueInfo
+          WRT key blob -> storeDataBlob key blob
+          CLR -> deleteDataBlob
       where
         createQueue :: QueueStore -> RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> SenderCanSecure -> M (Transmission BrokerMsg)
         createQueue st recipientKey dhKey subMode sndSecure = time "NEW" $ do
@@ -1067,7 +1075,9 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
               pure r
 
         withQueue :: (QueueRec -> M (Transmission BrokerMsg)) -> M (Transmission BrokerMsg)
-        withQueue action = maybe (pure $ err AUTH) action qr_
+        withQueue action = case vRes of
+          VRVerified (Just qr) -> action qr
+          _ -> pure $ err INTERNAL
 
         subscribeNotifications :: M (Transmission BrokerMsg)
         subscribeNotifications = time "NSUB" . atomically $ do
@@ -1278,7 +1288,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
           incStat $ pMsgFwdsRecv stats
           pure $ RRES r3
           where
-            rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
+            rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (VerificationResult, Transmission Cmd))
             rejectOrVerify clntThAuth (tAuth, authorized, (corrId', entId', cmdOrError)) =
               case cmdOrError of
                 Left e -> pure $ Left (corrId', entId', ERR e)
@@ -1289,10 +1299,12 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                     allowed = case cmd' of
                       Cmd SSender SEND {} -> True
                       Cmd SSender (SKEY _) -> True
+                      Cmd SSender READ -> True
                       _ -> False
                     verified = \case
-                      VRVerified qr -> Right (qr, (corrId', entId', cmd'))
                       VRFailed -> Left (corrId', entId', ERR AUTH)
+                      vRes' -> Right (vRes', (corrId', entId', cmd'))
+
         deliverMessage :: T.Text -> QueueRec -> RecipientId -> Sub -> Maybe Message -> M (Transmission BrokerMsg)
         deliverMessage name qr rId s@Sub {subThread} msg_ = time (name <> " deliver") . atomically $
           readTVar subThread >>= \case
@@ -1360,6 +1372,33 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
               qDelivered <- decodeLatin1 . encode <$$> tryReadTMVar delivered
               pure QSub {qSubThread, qDelivered}
 
+        storeDataBlob :: DataPublicAuthKey -> DataBlob -> M (Transmission BrokerMsg)
+        storeDataBlob dataKey dataBlob
+          | B.length (dataBody dataBlob) > e2eEncMessageLength = pure $ err LARGE_MSG
+          | otherwise = ok <$ (atomically . TM.insert entId d =<< asks dataStore)
+          where
+            d = DataRec {dataId = entId, dataKey, dataBlob}
+
+        deleteDataBlob :: M (Transmission BrokerMsg)
+        deleteDataBlob = ok <$ (atomically . TM.delete entId =<< asks dataStore)
+
+        getDataBlob :: M (Transmission BrokerMsg)
+        getDataBlob = case vRes of
+          VRVerifiedData (Just DataRec {dataBlob}) -> 
+            case thAuth thParams' of
+              Nothing -> pure $ err $ transportErr TENoServerAuth
+              Just THAuthServer {serverPrivKey} -> case X25519.publicKey entId of
+                CE.CryptoFailed _ -> pure $ err AUTH
+                CE.CryptoPassed k -> do
+                  let secret = C.dh' (C.PublicKeyX25519 k) serverPrivKey
+                      nonce = C.cbNonce $ bs corrId
+                      THandleParams {thVersion} = thParams'
+                  pure . (corrId,entId,) $
+                    case C.cbEncrypt secret nonce (smpEncode dataBlob) (maxMessageLength thVersion) of
+                      Left _ -> ERR CRYPTO
+                      Right encBlob -> DATA encBlob
+          _ -> pure $ err INTERNAL
+
         ok :: Transmission BrokerMsg
         ok = (corrId, entId, OK)
 

src/Simplex/Messaging/Server/DataStore.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Messaging.Server.DataStore where
+
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol
+
+data DataRec = DataRec
+  { dataId :: BlobId,
+    dataKey :: DataPublicAuthKey,
+    dataBlob :: DataBlob
+  }
+
+instance StrEncoding DataRec where
+  strEncode DataRec {dataId, dataKey, dataBlob} = strEncode (Str "v1", dataId, dataKey, dataBlob)
+  strP = do
+    (dataId, dataKey, dataBlob) <- "v1 " *> strP
+    pure DataRec {dataId, dataKey, dataBlob}

src/Simplex/Messaging/Server/Env/STM.hs

@@ -28,6 +28,7 @@ import Simplex.Messaging.Client.Agent (SMPClientAgent, SMPClientAgentConfig, new
 import Simplex.Messaging.Crypto (KeyHash (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
+import Simplex.Messaging.Server.DataStore
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.MsgStore.STM
@@ -118,6 +119,7 @@ data Env = Env
     serverIdentity :: KeyHash,
     queueStore :: QueueStore,
     msgStore :: STMMsgStore,
+    dataStore :: TMap BlobId DataRec,
     random :: TVar ChaChaDRG,
     storeLog :: Maybe (StoreLog 'WriteMode),
     tlsServerParams :: T.ServerParams,
@@ -144,11 +146,13 @@ newtype ProxyAgent = ProxyAgent
 
 type ClientId = Int
 
+data VerificationResult = VRVerified (Maybe QueueRec) | VRVerifiedData (Maybe DataRec) | VRFailed
+
 data Client = Client
   { clientId :: ClientId,
     subscriptions :: TMap RecipientId Sub,
     ntfSubscriptions :: TMap NotifierId (),
-    rcvQ :: TBQueue (NonEmpty (Maybe QueueRec, Transmission Cmd)),
+    rcvQ :: TBQueue (NonEmpty (VerificationResult, Transmission Cmd)),
     sndQ :: TBQueue (NonEmpty (Transmission BrokerMsg)),
     msgQ :: TBQueue (NonEmpty (Transmission BrokerMsg)),
     procThreads :: TVar Int,
@@ -205,6 +209,7 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
   server <- atomically newServer
   queueStore <- atomically newQueueStore
   msgStore <- atomically newMsgStore
+  dataStore <- atomically TM.empty
   random <- liftIO C.newRandom
   storeLog <- restoreQueues queueStore `mapM` storeLogFile
   tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
@@ -215,7 +220,7 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
   clientSeq <- newTVarIO 0
   clients <- newTVarIO mempty
   proxyAgent <- atomically $ newSMPProxyAgent smpAgentCfg random
-  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerParams, serverStats, sockets, clientSeq, clients, proxyAgent}
+  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, dataStore, random, storeLog, tlsServerParams, serverStats, sockets, clientSeq, clients, proxyAgent}
   where
     restoreQueues :: QueueStore -> FilePath -> IO (StoreLog 'WriteMode)
     restoreQueues QueueStore {queues, senders, notifiers} f = do

tests/ServerTests.hs

@@ -21,7 +21,10 @@ import Control.Concurrent.STM
 import Control.Exception (SomeException, try)
 import Control.Monad
 import Control.Monad.IO.Class
+import Crypto.Hash (SHA512)
+import qualified Crypto.KDF.HKDF as H
 import Data.Bifunctor (first)
+import qualified Data.ByteArray as BA
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -68,6 +71,7 @@ serverTests t@(ATransport t') = do
     testMsgExpireOnSend t'
     testMsgExpireOnInterval t'
     testMsgNOTExpireOnInterval t'
+  describe "Data blobs" $ testDataBlobs t'
 
 pattern Resp :: CorrId -> QueueId -> BrokerMsg -> SignedTransmission ErrorType BrokerMsg
 pattern Resp corrId queueId command <- (_, _, (corrId, queueId, Right command))
@@ -914,6 +918,79 @@ testMsgNOTExpireOnInterval t =
             Nothing -> return ()
             Just _ -> error "nothing else should be delivered"
 
+testDataBlobs :: forall c. Transport c => TProxy c -> Spec
+testDataBlobs t =
+  it "should store, retrieve, update and delete data blob directly from the server" $
+    smpTest2 t $ \r s -> do
+      g <- C.newRandom
+      -- 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
+      (blobKey, blobPKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      let kBytes = BA.convert k :: ByteString
+          rBlobId = C.sha256Hash kBytes
+          sBlobId = 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
+          origData = "hello"
+          origData2 = "hello 2"
+      dataNonce <- atomically $ C.randomCbNonce g
+      Right sk <- pure $ C.sbKey skBytes
+      -- store and retrieve blob
+      Right dataBody <- pure $ C.sbEncrypt sk dataNonce origData e2eEncConfirmationLength
+      let blob = DataBlob {dataNonce, dataBody}
+      -- storing data signed with the incorrect key fails (not matching key in command)
+      (_, blobPKey') <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      Resp "0" _ (ERR AUTH) <- signSendRecv r blobPKey' ("0", rBlobId, WRT blobKey blob)
+      -- correct key succeeds
+      Resp "1" _ OK <- signSendRecv r blobPKey ("1", rBlobId, WRT blobKey blob)
+      Resp "2" _ (DATA encBlob) <- sendRecv s ("", "2",  sBlobId, READ)
+      THandle {params = THandleParams {thAuth = Just THAuthClient {serverPeerPubKey}}} <- pure s
+      let ss = C.dh' serverPeerPubKey pk'
+          respNonce = C.cbNonce "2" -- correlation ID sent in READ request
+      Right blobStr <- pure $ C.cbDecrypt ss respNonce encBlob
+      Right  blob'@DataBlob {dataNonce = dataNonce', dataBody = body'} <- pure $ smpDecode blobStr
+      blob' `shouldBe` blob
+      Right origData' <- pure $ C.sbDecrypt sk dataNonce' body'
+      origData' `shouldBe` origData
+      -- update and retrieve blob
+      dataNonce2 <- atomically $ C.randomCbNonce g
+      Right dataBody2 <- pure $ C.sbEncrypt sk dataNonce2 origData2 e2eEncConfirmationLength
+      let blob2 = DataBlob {dataNonce = dataNonce2, dataBody = dataBody2}
+      -- storing data under the same ID but signed with the different key fails (even if it matches key in command)
+      (blobKey'', blobPKey'') <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      Resp "3" _ (ERR AUTH) <- signSendRecv r blobPKey'' ("3", rBlobId, WRT blobKey'' blob2)
+      -- same key but signed with the wrong key also fails
+      Resp "4" _ (ERR AUTH) <- signSendRecv r blobPKey'' ("4", rBlobId, WRT blobKey blob2)
+      -- same key bsucceeds
+      Resp "5" _ OK <- signSendRecv r blobPKey ("5", rBlobId, WRT blobKey blob2)
+      Resp "6" _ (DATA encBlob2) <- sendRecv s ("", "6",  sBlobId, READ)
+      let respNonce2 = C.cbNonce "6" -- correlation ID sent in READ request
+      Right blobStr2 <- pure $ C.cbDecrypt ss respNonce2 encBlob2
+      Right  blob2'@DataBlob {dataNonce = dataNonce2', dataBody = body2'} <- pure $ smpDecode blobStr2
+      blob2' `shouldBe` blob2
+      Right origData2' <- pure $ C.sbDecrypt sk dataNonce2' body2'
+      origData2' `shouldBe` origData2
+      -- remove data blob
+      -- incorrect ID fails
+      Resp "7" _ (ERR AUTH) <- signSendRecv r blobPKey ("7", sBlobId, CLR)
+      -- incorrect key fails
+      Resp "8" _ (ERR AUTH) <- signSendRecv r blobPKey'' ("8", rBlobId, CLR)
+      Resp "9" _ (DATA encBlob2') <- sendRecv s ("", "9",  sBlobId, READ)
+      encBlob2' `shouldBe` encBlob2'
+      -- correct key and ID succeed
+      Resp "10" _ OK <- signSendRecv r blobPKey ("10", rBlobId, CLR)
+      Resp "11" _ (ERR AUTH) <- sendRecv s ("", "11",  sBlobId, READ)
+      pure ()
+
 samplePubKey :: C.APublicVerifyKey
 samplePubKey = C.APublicVerifyKey C.SEd25519 "MCowBQYDK2VwAyEAfAOflyvbJv1fszgzkQ6buiZJVgSpQWsucXq7U6zjMgY="