mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-08-27 22:34:59 +00:00
secure queue by sender via proxy (proxy SKEY command) (#1210)
* client: secure queue by sender via proxy (proxy SKEY command) * agent and server: proxy SKEY command
This commit is contained in:
Evgeny Poberezkin
@@ -1026,7 +1026,27 @@ withSMPClient c q cmdStr action = do
|
||||
withLogClient c tSess (queueId q) cmdStr $ action . connectedClient
|
||||
|
||||
sendOrProxySMPMessage :: AgentClient -> UserId -> SMPServer -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer)
|
||||
sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do
|
||||
sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg =
|
||||
sendOrProxySMPCommand c userId destSrv cmdStr senderId sendViaProxy sendDirectly
|
||||
where
|
||||
sendViaProxy smp proxySess = do
|
||||
atomically $ incSMPServerStat c userId destSrv sentViaProxyAttempts
|
||||
atomically $ incSMPServerStat c userId (protocolClientServer' smp) sentProxiedAttempts
|
||||
proxySMPMessage smp proxySess spKey_ senderId msgFlags msg
|
||||
sendDirectly smp = do
|
||||
atomically $ incSMPServerStat c userId destSrv sentDirectAttempts
|
||||
sendSMPMessage smp spKey_ senderId msgFlags msg
|
||||
|
||||
sendOrProxySMPCommand ::
|
||||
AgentClient ->
|
||||
UserId ->
|
||||
SMPServer ->
|
||||
ByteString ->
|
||||
SMP.SenderId ->
|
||||
(SMPClient -> ProxiedRelay -> ExceptT SMPClientError IO (Either ProxyClientError ())) ->
|
||||
(SMPClient -> ExceptT SMPClientError IO ()) ->
|
||||
AM (Maybe SMPServer)
|
||||
sendOrProxySMPCommand c userId destSrv cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
|
||||
sess <- liftIO $ mkTransportSession c userId destSrv senderId
|
||||
ifM (atomically shouldUseProxy) (sendViaProxy sess) (sendDirectly sess $> Nothing)
|
||||
where
|
||||
@@ -1048,10 +1068,7 @@ sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do
|
||||
unknownServer = maybe True (all ((destSrv /=) . protoServer)) <$> TM.lookup userId (userServers c)
|
||||
sendViaProxy destSess@(_, _, qId) = do
|
||||
r <- tryAgentError . withProxySession c destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess) -> do
|
||||
r' <- liftClient SMP (clientServer smp) $ do
|
||||
atomically $ incSMPServerStat c userId destSrv sentViaProxyAttempts
|
||||
atomically $ incSMPServerStat c userId (protocolClientServer' smp) sentProxiedAttempts
|
||||
proxySMPMessage smp proxySess spKey_ senderId msgFlags msg
|
||||
r' <- liftClient SMP (clientServer smp) $ sendCmdViaProxy smp proxySess
|
||||
case r' of
|
||||
Right () -> pure . Just $ protocolClientServer' smp
|
||||
Left proxyErr -> do
|
||||
@@ -1089,11 +1106,7 @@ sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do
|
||||
| otherwise -> throwE e
|
||||
sendDirectly tSess =
|
||||
withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
|
||||
r <-
|
||||
tryAgentError $
|
||||
liftClient SMP (clientServer smp) $ do
|
||||
atomically $ incSMPServerStat c userId destSrv sentDirectAttempts
|
||||
sendSMPMessage smp spKey_ senderId msgFlags msg
|
||||
r <- tryAgentError $ liftClient SMP (clientServer smp) $ sendCmdDirectly smp
|
||||
case r of
|
||||
Right () -> atomically $ incSMPServerStat c userId destSrv sentDirect
|
||||
Left e -> throwE e
|
||||
@@ -1536,9 +1549,12 @@ secureQueue c rq@RcvQueue {rcvId, rcvPrivateKey} senderKey =
|
||||
secureSMPQueue smp rcvPrivateKey rcvId senderKey
|
||||
|
||||
secureSndQueue :: AgentClient -> SndQueue -> AM ()
|
||||
secureSndQueue c sq@SndQueue {sndId, sndPrivateKey, sndPublicKey} =
|
||||
withSMPClient c sq "SKEY <key>" $ \smp ->
|
||||
secureSndSMPQueue smp sndPrivateKey sndId sndPublicKey
|
||||
secureSndQueue c SndQueue {userId, server, sndId, sndPrivateKey, sndPublicKey} =
|
||||
void $ sendOrProxySMPCommand c userId server "SKEY <key>" sndId secureViaProxy secureDirectly
|
||||
where
|
||||
-- TODO track statistics
|
||||
secureViaProxy smp proxySess = proxySecureSndSMPQueue smp proxySess sndPrivateKey sndId sndPublicKey
|
||||
secureDirectly smp = secureSndSMPQueue smp sndPrivateKey sndId sndPublicKey
|
||||
|
||||
enableQueueNotifications :: AgentClient -> RcvQueue -> SMP.NtfPublicAuthKey -> SMP.RcvNtfPublicDhKey -> AM (SMP.NotifierId, SMP.RcvNtfPublicDhKey)
|
||||
enableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} notifierKey rcvNtfPublicDhKey =
|
||||
|
||||
@@ -48,6 +48,7 @@ module Simplex.Messaging.Client
|
||||
subscribeSMPQueuesNtfs,
|
||||
secureSMPQueue,
|
||||
secureSndSMPQueue,
|
||||
proxySecureSndSMPQueue,
|
||||
enableSMPQueueNotifications,
|
||||
disableSMPQueueNotifications,
|
||||
enableSMPQueuesNtfs,
|
||||
@@ -59,7 +60,7 @@ module Simplex.Messaging.Client
|
||||
deleteSMPQueues,
|
||||
connectSMPProxiedRelay,
|
||||
proxySMPMessage,
|
||||
forwardSMPMessage,
|
||||
forwardSMPTransmission,
|
||||
getSMPQueueInfo,
|
||||
sendProtocolCommand,
|
||||
|
||||
@@ -736,6 +737,10 @@ secureSndSMPQueue :: SMPClient -> SndPrivateAuthKey -> SenderId -> SndPublicAuth
|
||||
secureSndSMPQueue c spKey sId senderKey = okSMPCommand (SKEY senderKey) c spKey sId
|
||||
{-# 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)
|
||||
{-# INLINE proxySecureSndSMPQueue #-}
|
||||
|
||||
-- | Enable notifications for the queue for push notifications server.
|
||||
--
|
||||
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command
|
||||
@@ -776,6 +781,9 @@ sendSMPMessage c spKey sId flags msg =
|
||||
OK -> pure ()
|
||||
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)
|
||||
|
||||
-- | Acknowledge message delivery (server deletes the message).
|
||||
--
|
||||
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#acknowledge-message-delivery
|
||||
@@ -877,24 +885,24 @@ instance StrEncoding ProxyClientError where
|
||||
-- 8) PFWD(SEND) -> WTF -> ProxyUnexpectedResponse - client/proxy protocol logic
|
||||
-- 9) PFWD(SEND) -> ??? -> ProxyResponseError - client/proxy syntax
|
||||
--
|
||||
-- We report as proxySMPMessage error (ExceptT error) the errors of two kinds:
|
||||
-- We report as proxySMPCommand error (ExceptT error) the errors of two kinds:
|
||||
-- - protocol errors from the destination relay wrapped in PRES - to simplify processing of AUTH and QUOTA errors, in this case proxy is "transparent" for such errors (PCEProtocolError, PCEUnexpectedResponse, PCEResponseError)
|
||||
-- - other response/transport/connection errors from the client connected to proxy itself
|
||||
-- Other errors are reported in the function result as `Either ProxiedRelayError ()`, including
|
||||
-- - protocol errors from the client connected to proxy in ProxyClientError (PCEProtocolError, PCEUnexpectedResponse, PCEResponseError)
|
||||
-- - other errors from the client running on proxy and connected to relay in PREProxiedRelayError
|
||||
|
||||
proxySMPMessage ::
|
||||
-- This function proxies Sender commands that return OK or ERR
|
||||
proxySMPCommand ::
|
||||
SMPClient ->
|
||||
-- proxy session from PKEY
|
||||
ProxiedRelay ->
|
||||
-- message to deliver
|
||||
Maybe SndPrivateAuthKey ->
|
||||
SenderId ->
|
||||
MsgFlags ->
|
||||
MsgBody ->
|
||||
Command 'Sender ->
|
||||
ExceptT SMPClientError IO (Either ProxyClientError ())
|
||||
proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v serverKey) spKey sId flags msg = do
|
||||
proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v serverKey) spKey sId command = do
|
||||
-- prepare params
|
||||
let serverThAuth = (\ta -> ta {serverPeerPubKey = serverKey}) <$> thAuth proxyThParams
|
||||
serverThParams = smpTHParamsSetVersion v proxyThParams {sessionId, thAuth = serverThAuth}
|
||||
@@ -902,14 +910,14 @@ proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
|
||||
let cmdSecret = C.dh' serverKey cmdPrivKey
|
||||
nonce@(C.CbNonce corrId) <- liftIO . atomically $ C.randomCbNonce g
|
||||
-- encode
|
||||
let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender (SEND flags msg))
|
||||
let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender command)
|
||||
auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth spKey nonce tForAuth
|
||||
b <- case batchTransmissions (batch serverThParams) (blockSize serverThParams) [Right (auth, tToSend)] of
|
||||
[] -> throwE $ PCETransportError TELargeMsg
|
||||
TBError e _ : _ -> throwE $ PCETransportError e
|
||||
TBTransmission s _ : _ -> pure s
|
||||
TBTransmissions s _ _ : _ -> pure s
|
||||
et <- liftEitherWith PCECryptoError $ EncTransmission <$> C.cbEncrypt cmdSecret nonce b paddedProxiedMsgLength
|
||||
et <- liftEitherWith PCECryptoError $ EncTransmission <$> C.cbEncrypt cmdSecret nonce b paddedProxiedTLength
|
||||
-- proxy interaction errors are wrapped
|
||||
let tOut = Just $ 2 * tcpTimeout
|
||||
tryE (sendProtocolCommand_ c (Just nonce) tOut Nothing sessionId (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
|
||||
@@ -937,8 +945,8 @@ proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
|
||||
-- sends RFWD :: EncFwdTransmission -> Command Sender
|
||||
-- receives RRES :: EncFwdResponse -> BrokerMsg
|
||||
-- proxy should send PRES to the client with EncResponse
|
||||
forwardSMPMessage :: SMPClient -> CorrId -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO EncResponse
|
||||
forwardSMPMessage c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdVersion fwdKey fwdTransmission = do
|
||||
forwardSMPTransmission :: SMPClient -> CorrId -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO EncResponse
|
||||
forwardSMPTransmission c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdVersion fwdKey fwdTransmission = do
|
||||
-- prepare params
|
||||
sessSecret <- case thAuth thParams of
|
||||
Nothing -> throwE $ PCETransportError TENoServerAuth
|
||||
|
||||
@@ -43,7 +43,7 @@ module Simplex.Messaging.Protocol
|
||||
( -- * SMP protocol parameters
|
||||
supportedSMPClientVRange,
|
||||
maxMessageLength,
|
||||
paddedProxiedMsgLength,
|
||||
paddedProxiedTLength,
|
||||
e2eEncConfirmationLength,
|
||||
e2eEncMessageLength,
|
||||
|
||||
@@ -258,8 +258,8 @@ maxMessageLength v
|
||||
| v >= sendingProxySMPVersion = 16064 -- max 16067
|
||||
| otherwise = 16088 -- 16064 - always use this size to determine allowed ranges
|
||||
|
||||
paddedProxiedMsgLength :: Int
|
||||
paddedProxiedMsgLength = 16242 -- 16241 .. 16243
|
||||
paddedProxiedTLength :: Int
|
||||
paddedProxiedTLength = 16242 -- 16241 .. 16243
|
||||
|
||||
-- TODO v6.0 change to 16064
|
||||
type MaxMessageLen = 16088
|
||||
|
||||
@@ -70,7 +70,7 @@ import GHC.Stats (getRTSStats)
|
||||
import GHC.TypeLits (KnownNat)
|
||||
import Network.Socket (ServiceName, Socket, socketToHandle)
|
||||
import Simplex.Messaging.Agent.Lock
|
||||
import Simplex.Messaging.Client (ProtocolClient (thParams), ProtocolClientError (..), SMPClient, SMPClientError, forwardSMPMessage, smpProxyError, temporaryClientError)
|
||||
import Simplex.Messaging.Client (ProtocolClient (thParams), ProtocolClientError (..), SMPClient, SMPClientError, forwardSMPTransmission, smpProxyError, temporaryClientError)
|
||||
import Simplex.Messaging.Client.Agent (OwnServer, SMPClientAgent (..), SMPClientAgentEvent (..), closeSMPClientAgent, getSMPServerClient'', isOwnServer, lookupSMPServerClient, getConnectedSMPServerClient)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding
|
||||
@@ -742,7 +742,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
|
||||
inc own pRequests
|
||||
if v >= sendingProxySMPVersion
|
||||
then forkProxiedCmd $ do
|
||||
liftIO (runExceptT (forwardSMPMessage smp corrId fwdV pubKey encBlock) `catch` (pure . Left . PCEIOError)) >>= \case
|
||||
liftIO (runExceptT (forwardSMPTransmission smp corrId fwdV pubKey encBlock) `catch` (pure . Left . PCEIOError)) >>= \case
|
||||
Right r -> PRES r <$ inc own pSuccesses
|
||||
Left e -> ERR (smpProxyError e) <$ case e of
|
||||
PCEProtocolError {} -> inc own pSuccesses
|
||||
@@ -1095,16 +1095,13 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
|
||||
t :| [] -> pure $ tDecodeParseValidate clntTHParams t
|
||||
_ -> throwE BLOCK
|
||||
let clntThAuth = Just $ THAuthServer {serverPrivKey, sessSecret' = Just clientSecret}
|
||||
-- process forwarded SEND
|
||||
-- process forwarded command
|
||||
r <-
|
||||
lift (rejectOrVerify clntThAuth t') >>= \case
|
||||
Left r -> pure r
|
||||
Right t''@(_, (corrId', entId', cmd')) -> case cmd' of
|
||||
Cmd SSender SEND {} ->
|
||||
-- Left will not be returned by processCommand, as only SEND command is allowed
|
||||
fromMaybe (corrId', entId', ERR INTERNAL) <$> lift (processCommand t'')
|
||||
_ ->
|
||||
pure (corrId', entId', ERR $ CMD PROHIBITED)
|
||||
-- rejectOrVerify filters allowed commands, no need to repeat it here.
|
||||
-- INTERNAL is used because processCommand never returns Nothing for sender commands (could be extracted for better types).
|
||||
Right t''@(_, (corrId', entId', _)) -> fromMaybe (corrId', entId', ERR INTERNAL) <$> lift (processCommand t'')
|
||||
-- encode response
|
||||
r' <- case batchTransmissions (batch clntTHParams) (blockSize clntTHParams) [Right (Nothing, encodeTransmission clntTHParams r)] of
|
||||
[] -> throwE INTERNAL -- at least 1 item is guaranteed from NonEmpty/Right
|
||||
@@ -1112,7 +1109,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
|
||||
TBTransmission b' _ : _ -> pure b'
|
||||
TBTransmissions b' _ _ : _ -> pure b'
|
||||
-- encrypt to client
|
||||
r2 <- liftEitherWith (const BLOCK) $ EncResponse <$> C.cbEncrypt clientSecret (C.reverseNonce clientNonce) r' paddedProxiedMsgLength
|
||||
r2 <- liftEitherWith (const BLOCK) $ EncResponse <$> C.cbEncrypt clientSecret (C.reverseNonce clientNonce) r' paddedProxiedTLength
|
||||
-- encrypt to proxy
|
||||
let fr = FwdResponse {fwdCorrId, fwdResponse = r2}
|
||||
r3 = EncFwdResponse $ C.cbEncryptNoPad sessSecret (C.reverseNonce proxyNonce) (smpEncode fr)
|
||||
@@ -1124,13 +1121,17 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
|
||||
rejectOrVerify clntThAuth (tAuth, authorized, (corrId', entId', cmdOrError)) =
|
||||
case cmdOrError of
|
||||
Left e -> pure $ Left (corrId', entId', ERR e)
|
||||
Right cmd'@(Cmd SSender SEND {}) -> verified <$> verifyTransmission ((,C.cbNonce (bs corrId')) <$> clntThAuth) tAuth authorized entId' cmd'
|
||||
Right cmd'
|
||||
| allowed -> verified <$> verifyTransmission ((,C.cbNonce (bs corrId')) <$> clntThAuth) tAuth authorized entId' cmd'
|
||||
| otherwise -> pure $ Left (corrId', entId', ERR $ CMD PROHIBITED)
|
||||
where
|
||||
allowed = case cmd' of
|
||||
Cmd SSender SEND {} -> True
|
||||
Cmd SSender (SKEY _) -> True
|
||||
_ -> False
|
||||
verified = \case
|
||||
VRVerified qr -> Right (qr, (corrId', entId', cmd'))
|
||||
VRFailed -> Left (corrId', entId', ERR AUTH)
|
||||
Right _ -> pure $ Left (corrId', entId', ERR $ CMD PROHIBITED)
|
||||
|
||||
deliverMessage :: T.Text -> QueueRec -> RecipientId -> TVar Sub -> MsgQueue -> Maybe Message -> M (Transmission BrokerMsg)
|
||||
deliverMessage name qr rId sub q msg_ = time (name <> " deliver") $ do
|
||||
readTVarIO sub >>= \case
|
||||
|
||||
Reference in New Issue
Block a user