From a99ce6122ca0bab9935f54c3c1f1c80d5e11bb80 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 30 Jun 2024 16:20:54 +0100 Subject: [PATCH] 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 --- src/Simplex/Messaging/Agent/Client.hs | 42 ++++++++++++++++++--------- src/Simplex/Messaging/Client.hs | 28 +++++++++++------- src/Simplex/Messaging/Protocol.hs | 6 ++-- src/Simplex/Messaging/Server.hs | 27 ++++++++--------- 4 files changed, 64 insertions(+), 39 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index d049cfeb0..01d97f9ac 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -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 " $ \smp -> - secureSndSMPQueue smp sndPrivateKey sndId sndPublicKey +secureSndQueue c SndQueue {userId, server, sndId, sndPrivateKey, sndPublicKey} = + void $ sendOrProxySMPCommand c userId server "SKEY " 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 = diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 39cf32677..e20b00039 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -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 diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index d1b3f85d6..63e3e4d98 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -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 diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index f673018bf..e96e8b582 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -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