Merge pull request #1095 from simplex-chat/proxy

SMP proxy feature branch
2026-08-28 00:44:38 +00:00 · 2024-05-14 21:35:51 +01:00
parent f51cf1deac 00a2dde727
commit 2d2cc86bd8
38 changed files with 1793 additions and 469 deletions
@@ -51,13 +51,13 @@ import Simplex.Messaging.Protocol
    RecipientId,
    SenderId,
  )
-import Simplex.Messaging.Transport (ALPN, HandshakeError (VERSION), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), supportedParameters)
+import Simplex.Messaging.Transport (ALPN, THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), supportedParameters)
 import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.Client
 import Simplex.Messaging.Transport.HTTP2.File
 import Simplex.Messaging.Util (bshow, liftEitherWith, liftError', tshow, whenM)
-import Simplex.Messaging.Version (compatibleVersion, pattern Compatible)
+import Simplex.Messaging.Version
 import UnliftIO
 import UnliftIO.Directory

@@ -99,22 +99,24 @@ defaultXFTPClientConfig =

 getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
 getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} disconnected = runExceptT $ do
-  let tcConfig = (transportClientConfig xftpNetworkConfig) {alpn = clientALPN}
-      http2Config = xftpHTTP2Config tcConfig config
-      username = proxyUsername transportSession
+  let username = proxyUsername transportSession
      ProtocolServer _ host port keyHash = srv
  useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
+  let tcConfig = (transportClientConfig xftpNetworkConfig useHost) {alpn = clientALPN}
+      http2Config = xftpHTTP2Config tcConfig config
  clientVar <- newTVarIO Nothing
  let usePort = if null port then "443" else port
      clientDisconnected = readTVarIO clientVar >>= mapM_ disconnected
  http2Client <- liftError' xftpClientError $ getVerifiedHTTP2Client (Just username) useHost usePort (Just keyHash) Nothing http2Config clientDisconnected
  let HTTP2Client {sessionId, sessionALPN} = http2Client
-      thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = VersionXFTP 1, thAuth = Nothing, implySessId = False, batch = True}
+      v = VersionXFTP 1
+      thServerVRange = versionToRange v
+      thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, batch = True}
  logDebug $ "Client negotiated handshake protocol: " <> tshow sessionALPN
  thParams@THandleParams {thVersion} <- case sessionALPN of
    Just "xftp/1" -> xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
    Nothing -> pure thParams0
-    _ -> throwError $ PCETransportError (TEHandshake VERSION)
+    _ -> throwError $ PCETransportError TEVersion
  logDebug $ "Client negotiated protocol: " <> tshow thVersion
  let c = XFTPClient {http2Client, thParams, transportSession, config}
  atomically $ writeTVar clientVar $ Just c
@@ -123,9 +125,10 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
 xftpClientHandshakeV1 :: VersionRangeXFTP -> C.KeyHash -> HTTP2Client -> THandleParamsXFTP 'TClient -> ExceptT XFTPClientError IO (THandleParamsXFTP 'TClient)
 xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {sessionId, serverKey} thParams0 = do
  shs@XFTPServerHandshake {authPubKey = ck} <- getServerHandshake
-  (v, sk) <- processServerHandshake shs
+  (vr, sk) <- processServerHandshake shs
+  let v = maxVersion vr
  sendClientHandshake XFTPClientHandshake {xftpVersion = v, keyHash}
-  pure thParams0 {thAuth = Just THAuthClient {serverPeerPubKey = sk, serverCertKey = ck, sessSecret = Nothing}, thVersion = v}
+  pure thParams0 {thAuth = Just THAuthClient {serverPeerPubKey = sk, serverCertKey = ck, sessSecret = Nothing}, thVersion = v, thServerVRange = vr}
  where
    getServerHandshake :: ExceptT XFTPClientError IO XFTPServerHandshake
    getServerHandshake = do
@@ -133,13 +136,13 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
      HTTP2Response {respBody = HTTP2Body {bodyHead = shsBody}} <-
        liftError' (const $ PCEResponseError HANDSHAKE) $ sendRequest c helloReq Nothing
      liftHS . smpDecode =<< liftHS (C.unPad shsBody)
-    processServerHandshake :: XFTPServerHandshake -> ExceptT XFTPClientError IO (VersionXFTP, C.PublicKeyX25519)
+    processServerHandshake :: XFTPServerHandshake -> ExceptT XFTPClientError IO (VersionRangeXFTP, C.PublicKeyX25519)
    processServerHandshake XFTPServerHandshake {xftpVersionRange, sessionId = serverSessId, authPubKey = serverAuth} = do
      unless (sessionId == serverSessId) $ throwError $ PCEResponseError SESSION
-      case xftpVersionRange `compatibleVersion` serverVRange of
-        Nothing -> throwError $ PCEResponseError HANDSHAKE
-        Just (Compatible v) ->
-          fmap (v,) . liftHS $ do
+      case xftpVersionRange `compatibleVRange` serverVRange of
+        Nothing -> throwError $ PCETransportError TEVersion
+        Just (Compatible vr) ->
+          fmap (vr,) . liftHS $ do
            let (X.CertificateChain cert, exact) = serverAuth
            case cert of
              [_leaf, ca] | XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 -> pure ()
@@ -185,9 +188,11 @@ xftpClientError = \case

 sendXFTPCommand :: forall p. FilePartyI p => XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> FileCommand p -> Maybe XFTPChunkSpec -> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
 sendXFTPCommand c@XFTPClient {thParams} pKey fId cmd chunkSpec_ = do
+  -- TODO random corrId
+  let corrIdUsedAsNonce = ""
  t <-
    liftEither . first PCETransportError $
-      xftpEncodeAuthTransmission thParams pKey ("", fId, FileCmd (sFileParty @p) cmd)
+      xftpEncodeAuthTransmission thParams pKey (corrIdUsedAsNonce, fId, FileCmd (sFileParty @p) cmd)
  sendXFTPTransmission c t chunkSpec_

 sendXFTPTransmission :: XFTPClient -> ByteString -> Maybe XFTPChunkSpec -> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
@@ -48,6 +48,7 @@ import Simplex.Messaging.Protocol
    SndPublicAuthKey,
    Transmission,
    TransmissionForAuth (..),
+    CorrId (..),
    encodeTransmission,
    encodeTransmissionForAuth,
    messageTagP,
@@ -328,7 +329,7 @@ checkParty' c = case testEquality (sFileParty @p) (sFileParty @p') of
 xftpEncodeAuthTransmission :: ProtocolEncoding XFTPVersion e c => THandleParams XFTPVersion 'TClient -> C.APrivateAuthKey -> Transmission c -> Either TransportError ByteString
 xftpEncodeAuthTransmission thParams@THandleParams {thAuth} pKey (corrId, fId, msg) = do
  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (corrId, fId, msg)
-  xftpEncodeBatch1 . (,tToSend) =<< authTransmission thAuth (Just pKey) corrId tForAuth
+  xftpEncodeBatch1 . (,tToSend) =<< authTransmission thAuth (Just pKey) (C.cbNonce $ bs corrId) tForAuth

 xftpEncodeTransmission :: ProtocolEncoding XFTPVersion e c => THandleParams XFTPVersion p -> Transmission c -> Either TransportError ByteString
 xftpEncodeTransmission thParams (corrId, fId, msg) = do
@@ -63,7 +63,7 @@ import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
 import Simplex.Messaging.Transport.HTTP2.Server
 import Simplex.Messaging.Transport.Server (runTCPServer, tlsServerCredentials)
 import Simplex.Messaging.Util
-import Simplex.Messaging.Version (isCompatible)
+import Simplex.Messaging.Version
 import System.Exit (exitFailure)
 import System.FilePath ((</>))
 import System.IO (hPrint, hPutStrLn, universalNewlineMode)
@@ -91,10 +91,10 @@ runXFTPServerBlocking started cfg = newXFTPServerEnv cfg >>= runReaderT (xftpSer

 data Handshake
  = HandshakeSent C.PrivateKeyX25519
-  | HandshakeAccepted (THandleAuth 'TServer) VersionXFTP
+  | HandshakeAccepted (THandleParams XFTPVersion 'TServer)

 xftpServer :: XFTPServerConfig -> TMVar Bool -> M ()
-xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration} started = do
+xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration, xftpServerVRange} started = do
  mapM_ (expireServerFiles Nothing) fileExpiration
  restoreServerStats
  raceAny_ (runServer : expireFilesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg) `finally` stopServer
@@ -111,7 +111,9 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
      let cleanup sessionId = atomically $ TM.delete sessionId sessions
      liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize serverParams transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
        reqBody <- getHTTP2Body r xftpBlockSize
-        let thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = VersionXFTP 1, thAuth = Nothing, implySessId = False, batch = True}
+        let v = VersionXFTP 1
+            thServerVRange = versionToRange v
+            thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, batch = True}
            req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse}
        flip runReaderT env $ case sessionALPN of
          Nothing -> processRequest req0
@@ -121,12 +123,12 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
              Just thParams -> processRequest req0 {thParams} -- proceed with new version (XXX: may as well switch the request handler here)
          _ -> liftIO . sendResponse $ H.responseNoBody N.ok200 [] -- shouldn't happen: means server picked handshake protocol it doesn't know about
    xftpServerHandshakeV1 :: X.CertificateChain -> C.APrivateSignKey -> TMap SessionId Handshake -> XFTPTransportRequest -> M (Maybe (THandleParams XFTPVersion 'TServer))
-    xftpServerHandshakeV1 chain serverSignKey sessions XFTPTransportRequest {thParams = thParams@THandleParams {sessionId}, reqBody = HTTP2Body {bodyHead}, sendResponse} = do
+    xftpServerHandshakeV1 chain serverSignKey sessions XFTPTransportRequest {thParams = thParams0@THandleParams {sessionId}, reqBody = HTTP2Body {bodyHead}, sendResponse} = do
      s <- atomically $ TM.lookup sessionId sessions
      r <- runExceptT $ case s of
        Nothing -> processHello
        Just (HandshakeSent pk) -> processClientHandshake pk
-        Just (HandshakeAccepted auth v) -> pure $ Just thParams {thAuth = Just auth, thVersion = v}
+        Just (HandshakeAccepted thParams) -> pure $ Just thParams
      either sendError pure r
      where
        processHello = do
@@ -134,21 +136,24 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
          (k, pk) <- atomically . C.generateKeyPair =<< asks random
          atomically $ TM.insert sessionId (HandshakeSent pk) sessions
          let authPubKey = (chain, C.signX509 serverSignKey $ C.publicToX509 k)
-          let hs = XFTPServerHandshake {xftpVersionRange = supportedFileServerVRange, sessionId, authPubKey}
+          let hs = XFTPServerHandshake {xftpVersionRange = xftpServerVRange, sessionId, authPubKey}
          shs <- encodeXftp hs
          liftIO . sendResponse $ H.responseBuilder N.ok200 [] shs
          pure Nothing
        processClientHandshake pk = do
          unless (B.length bodyHead == xftpBlockSize) $ throwError HANDSHAKE
          body <- liftHS $ C.unPad bodyHead
-          XFTPClientHandshake {xftpVersion, keyHash} <- liftHS $ smpDecode body
+          XFTPClientHandshake {xftpVersion = v, keyHash} <- liftHS $ smpDecode body
          kh <- asks serverIdentity
          unless (keyHash == kh) $ throwError HANDSHAKE
-          unless (xftpVersion `isCompatible` supportedFileServerVRange) $ throwError HANDSHAKE
-          let auth = THAuthServer {serverPrivKey = pk, sessSecret' = Nothing}
-          atomically $ TM.insert sessionId (HandshakeAccepted auth xftpVersion) sessions
-          liftIO . sendResponse $ H.responseNoBody N.ok200 []
-          pure Nothing
+          case compatibleVRange' xftpServerVRange v of
+            Just (Compatible vr) -> do
+              let auth = THAuthServer {serverPrivKey = pk, sessSecret' = Nothing}
+                  thParams = thParams0 {thAuth = Just auth, thVersion = v, thServerVRange = vr}
+              atomically $ TM.insert sessionId (HandshakeAccepted thParams) sessions
+              liftIO . sendResponse $ H.responseNoBody N.ok200 []
+              pure Nothing
+            Nothing -> throwError HANDSHAKE
        sendError :: XFTPErrorType -> M (Maybe (THandleParams XFTPVersion 'TServer))
        sendError err = do
          runExceptT (encodeXftp err) >>= \case
@@ -25,6 +25,7 @@ import Simplex.FileTransfer.Protocol (FileCmd, FileInfo (..), XFTPFileId)
 import Simplex.FileTransfer.Server.Stats
 import Simplex.FileTransfer.Server.Store
 import Simplex.FileTransfer.Server.StoreLog
+import Simplex.FileTransfer.Transport (VersionRangeXFTP)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (BasicAuth, RcvPublicAuthKey)
 import Simplex.Messaging.Server.Expiration
@@ -61,6 +62,8 @@ data XFTPServerConfig = XFTPServerConfig
    caCertificateFile :: FilePath,
    privateKeyFile :: FilePath,
    certificateFile :: FilePath,
+    -- | XFTP client-server protocol version range
+    xftpServerVRange :: VersionRangeXFTP,
    -- stats config - see SMP server config
    logStatsInterval :: Maybe Int64,
    logStatsStartTime :: Int64,
@@ -20,6 +20,7 @@ import Simplex.FileTransfer.Chunks
 import Simplex.FileTransfer.Description (FileSize (..))
 import Simplex.FileTransfer.Server (runXFTPServer)
 import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration, supportedXFTPhandshakes)
+import Simplex.FileTransfer.Transport (supportedFileServerVRange)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
@@ -174,6 +175,7 @@ xftpServerCLI cfgPath logPath = do
              caCertificateFile = c caCrtFile,
              privateKeyFile = c serverKeyFile,
              certificateFile = c serverCrtFile,
+              xftpServerVRange = supportedFileServerVRange,
              logStatsInterval = logStats $> 86400, -- seconds
              logStatsStartTime = 0, -- seconds from 00:00 UTC
              serverStatsLogFile = combine logPath "file-server-stats.daily.log",
@@ -37,6 +37,7 @@ import qualified Control.Exception as E
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
 import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (bimap, first)
@@ -53,7 +54,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol (CommandError)
-import Simplex.Messaging.Transport (HandshakeError (..), SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
+import Simplex.Messaging.Transport (SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
 import Simplex.Messaging.Transport.HTTP2.File
 import Simplex.Messaging.Util (bshow)
 import Simplex.Messaging.Version
@@ -95,7 +96,7 @@ supportedFileServerVRange = mkVersionRange initialXFTPVersion currentXFTPVersion

 -- XFTP protocol does not use this handshake method
 xftpClientHandshakeStub :: c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
-xftpClientHandshakeStub _c _ks _keyHash _xftpVRange = throwError $ TEHandshake VERSION
+xftpClientHandshakeStub _c _ks _keyHash _xftpVRange = throwE TEVersion

 data XFTPServerHandshake = XFTPServerHandshake
  { xftpVersionRange :: VersionRangeXFTP,
@@ -849,7 +849,7 @@ joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo
  lift (compatibleContactUri cReqUri) >>= \case
    Just (qInfo, vrsn) -> do
      (connId', cReq) <- newConnSrv c userId connId hasNewConn enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv
-      sendInvitation c userId qInfo vrsn cReq cInfo
+      void $ sendInvitation c userId qInfo vrsn cReq cInfo
      pure connId'
    Nothing -> throwError $ AGENT A_VERSION

@@ -1358,13 +1358,17 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork
                  | temporaryOrHostError e -> do
                      let msgTimeout = if msgType == AM_HELLO_ then helloTimeout else messageTimeout
                      expireTs <- addUTCTime (-msgTimeout) <$> liftIO getCurrentTime
-                      if internalTs < expireTs then notifyDelMsgs msgId e expireTs else retrySndMsg RIFast
+                      if internalTs < expireTs
+                        then notifyDelMsgs msgId e expireTs
+                        else do
+                          when (serverHostError e) $ notify $ MWARN (unId msgId) e
+                          retrySndMsg RIFast
                  | otherwise -> notifyDel msgId err
              where
                retrySndMsg riMode = do
                  withStore' c $ \db -> updatePendingMsgRIState db connId msgId riState
                  retrySndOp c $ loop riMode
-            Right () -> do
+            Right proxySrv_ -> do
              case msgType of
                AM_CONN_INFO -> setConfirmed
                AM_CONN_INFO_REPLY -> setConfirmed
@@ -1386,7 +1390,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork
                      when (status == Active) $ notify $ CON pqEncryption
                    -- this branch should never be reached as receive queue is created before the confirmation,
                    _ -> logError "HELLO sent without receive queue"
-                AM_A_MSG_ -> notify $ SENT mId
+                AM_A_MSG_ -> notify $ SENT mId proxySrv_
                AM_A_RCVD_ -> pure ()
                AM_QCONT_ -> pure ()
                AM_QADD_ -> pure ()
@@ -2089,10 +2093,10 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v,
      conn
      cData@ConnData {userId, connId, connAgentVersion, ratchetSyncState = rss} =
        withConnLock c connId "processSMP" $ case cmd of
-          Right (SMP.MSG msg@SMP.RcvMessage {msgId = srvMsgId}) ->
+          Right r@(SMP.MSG msg@SMP.RcvMessage {msgId = srvMsgId}) ->
            void . handleNotifyAck $ do
              isGET <- atomically $ hasGetLock c rq
-              unless isGET checkExpiredResponse
+              unless isGET $ checkExpiredResponse r
              msg' <- decryptSMPMessage rq msg
              ack' <- handleNotifyAck $ case msg' of
                SMP.ClientRcvMsgBody {msgTs = srvTs, msgFlags, msgBody} -> processClientMsg srvTs msgFlags msgBody
@@ -2262,7 +2266,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v,
            where
              processEND = \case
                Just (Right clnt)
-                  | sessId == sessionId (thParams clnt) -> do
+                  | sessId == sessionId (thParams $ connectedClient clnt) -> do
                      removeSubscription c connId
                      notify' END
                      pure "END"
@@ -2270,8 +2274,8 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v,
                _ -> ignored
              ignored = pure "END from disconnected client - ignored"
          Right (SMP.ERR e) -> notify $ ERR $ SMP (B.unpack $ strEncode srv) e
-          Right SMP.OK -> checkExpiredResponse
-          Right _ -> unexpected
+          Right r@SMP.OK -> checkExpiredResponse r
+          Right r -> unexpected r
          Left e -> notify $ ERR $ protocolClientError SMP (B.unpack $ strEncode srv) e
        where
          notify :: forall e m. MonadIO m => AEntityI e => ACommand 'Agent e -> m ()
@@ -2286,16 +2290,16 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v,
          enqueueCmd :: InternalCommand -> AM ()
          enqueueCmd = enqueueCommand c "" connId (Just srv) . AInternalCommand

-          unexpected :: AM ()
-          unexpected = do
+          unexpected :: BrokerMsg -> AM ()
+          unexpected r = do
            logServer "<--" c srv rId $ "unexpected: " <> bshow cmd
            -- TODO add extended information about transmission type once UNEXPECTED has string
-            notify . ERR $ BROKER (B.unpack $ strEncode srv) UNEXPECTED
+            notify . ERR $ BROKER (B.unpack $ strEncode srv) $ UNEXPECTED (take 32 $ show r)

-          checkExpiredResponse :: AM ()
-          checkExpiredResponse = case tType of
+          checkExpiredResponse :: BrokerMsg -> AM ()
+          checkExpiredResponse r = case tType of
            TTEvent -> pure ()
-            TTUncorrelatedResponse -> unexpected
+            TTUncorrelatedResponse -> unexpected r
            TTExpiredResponse (SMP.Cmd _ cmd') -> case cmd' of
              SMP.SUB -> do
                added <-
@@ -2643,7 +2647,7 @@ confirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do
 confirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
 confirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connInfo e2eEncryption_ subMode = do
  msg <- mkConfirmation =<< mkAgentConfirmation c cData sq srv connInfo subMode
-  sendConfirmation c sq msg
+  void $ sendConfirmation c sq msg
  withStore' c $ \db -> setSndQueueStatus db sq Confirmed
  where
    mkConfirmation :: AgentMessage -> AM MsgBody
@@ -47,6 +47,7 @@ module Simplex.Messaging.Agent.Client
    sendInvitation,
    temporaryAgentError,
    temporaryOrHostError,
+    serverHostError,
    secureQueue,
    enableQueueNotifications,
    enableQueuesNtfs,
@@ -136,6 +137,8 @@ module Simplex.Messaging.Agent.Client
    SMPTransportSession,
    NtfTransportSession,
    XFTPTransportSession,
+    ProxiedRelay (..),
+    SMPConnectedClient (..),
  )
 where

@@ -149,6 +152,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
+import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as J
@@ -234,8 +238,8 @@ import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Session
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (SMPVersion, SessionId, THandleParams (sessionId))
-import Simplex.Messaging.Transport.Client (TransportHost)
+import Simplex.Messaging.Transport (SMPVersion, SessionId, THandleParams (sessionId), TransportError (..))
+import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Mem.Weak (Weak)
@@ -268,6 +272,10 @@ data AgentClient = AgentClient
    msgQ :: TBQueue (ServerTransmission SMPVersion ErrorType BrokerMsg),
    smpServers :: TMap UserId (NonEmpty SMPServerWithAuth),
    smpClients :: TMap SMPTransportSession SMPClientVar,
+    -- smpProxiedRelays:
+    -- SMPTransportSession defines connection from proxy to relay,
+    -- SMPServerWithAuth defines client connected to SMP proxy (with the same userId and entityId in TransportSession)
+    smpProxiedRelays :: TMap SMPTransportSession SMPServerWithAuth,
    ntfServers :: TVar [NtfServer],
    ntfClients :: TMap NtfTransportSession NtfClientVar,
    xftpServers :: TMap UserId (NonEmpty XFTPServerWithAuth),
@@ -303,6 +311,13 @@ data AgentClient = AgentClient
    agentEnv :: Env
  }

+data SMPConnectedClient = SMPConnectedClient
+  { connectedClient :: SMPClient,
+    proxiedRelays :: TMap SMPServer ProxiedRelayVar
+  }
+
+type ProxiedRelayVar = SessionVar (Either AgentErrorType ProxiedRelay)
+
 getAgentWorker :: (Ord k, Show k) => String -> Bool -> AgentClient -> k -> TMap k Worker -> (Worker -> AM ()) -> AM' Worker
 getAgentWorker = getAgentWorker' id pure
 {-# INLINE getAgentWorker #-}
@@ -434,6 +449,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv =
  msgQ <- newTBQueue qSize
  smpServers <- newTVar smp
  smpClients <- TM.empty
+  smpProxiedRelays <- TM.empty
  ntfServers <- newTVar ntf
  ntfClients <- TM.empty
  xftpServers <- newTVar xftp
@@ -470,6 +486,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv =
        msgQ,
        smpServers,
        smpClients,
+        smpProxiedRelays,
        ntfServers,
        ntfClients,
        xftpServers,
@@ -519,15 +536,19 @@ agentDRG AgentClient {agentEnv = Env {random}} = random
 class (Encoding err, Show err) => ProtocolServerClient v err msg | msg -> v, msg -> err where
  type Client msg = c | c -> msg
  getProtocolServerClient :: AgentClient -> TransportSession msg -> AM (Client msg)
+  type ProtoClient msg = c | c -> msg
+  protocolClient :: Client msg -> ProtoClient msg
  clientProtocolError :: HostName -> err -> AgentErrorType
-  closeProtocolServerClient :: Client msg -> IO ()
-  clientServer :: Client msg -> String
-  clientTransportHost :: Client msg -> TransportHost
-  clientSessionTs :: Client msg -> UTCTime
+  closeProtocolServerClient :: ProtoClient msg -> IO ()
+  clientServer :: ProtoClient msg -> String
+  clientTransportHost :: ProtoClient msg -> TransportHost
+  clientSessionTs :: ProtoClient msg -> UTCTime

 instance ProtocolServerClient SMPVersion ErrorType BrokerMsg where
-  type Client BrokerMsg = ProtocolClient SMPVersion ErrorType BrokerMsg
+  type Client BrokerMsg = SMPConnectedClient
  getProtocolServerClient = getSMPServerClient
+  type ProtoClient BrokerMsg = ProtocolClient SMPVersion ErrorType BrokerMsg
+  protocolClient = connectedClient
  clientProtocolError = SMP
  closeProtocolServerClient = closeProtocolClient
  clientServer = protocolClientServer
@@ -537,6 +558,8 @@ instance ProtocolServerClient SMPVersion ErrorType BrokerMsg where
 instance ProtocolServerClient NTFVersion ErrorType NtfResponse where
  type Client NtfResponse = ProtocolClient NTFVersion ErrorType NtfResponse
  getProtocolServerClient = getNtfServerClient
+  type ProtoClient NtfResponse = ProtocolClient NTFVersion ErrorType NtfResponse
+  protocolClient = id
  clientProtocolError = NTF
  closeProtocolServerClient = closeProtocolClient
  clientServer = protocolClientServer
@@ -546,61 +569,121 @@ instance ProtocolServerClient NTFVersion ErrorType NtfResponse where
 instance ProtocolServerClient XFTPVersion XFTPErrorType FileResponse where
  type Client FileResponse = XFTPClient
  getProtocolServerClient = getXFTPServerClient
+  type ProtoClient FileResponse = XFTPClient
+  protocolClient = id
  clientProtocolError = XFTP
  closeProtocolServerClient = X.closeXFTPClient
  clientServer = X.xftpClientServer
  clientTransportHost = X.xftpTransportHost
  clientSessionTs = X.xftpSessionTs

-getSMPServerClient :: AgentClient -> SMPTransportSession -> AM SMPClient
-getSMPServerClient c@AgentClient {active, smpClients, msgQ, workerSeq} tSess@(userId, srv, _) = do
+getSMPServerClient :: AgentClient -> SMPTransportSession -> AM SMPConnectedClient
+getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
  unlessM (readTVarIO active) . throwError $ INACTIVE
  atomically (getSessVar workerSeq tSess smpClients)
    >>= either newClient (waitForProtocolClient c tSess)
  where
-    -- we resubscribe only on newClient error, but not on waitForProtocolClient error,
-    -- as the large number of delivery workers waiting for the client TMVar
-    -- make it expensive to check for pending subscriptions.
-    newClient v =
-      newProtocolClient c tSess smpClients connectClient v
-        `catchAgentError` \e -> lift (resubscribeSMPSession c tSess) >> throwError e
-    connectClient :: SMPClientVar -> AM SMPClient
-    connectClient v = do
+    newClient v = do
+      prs <- atomically TM.empty
+      smpConnectClient c tSess prs v
+
+getSMPProxyClient :: AgentClient -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
+getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq} destSess@(userId, destSrv, qId) = do
+  unlessM (readTVarIO active) . throwError $ INACTIVE
+  proxySrv <- getNextServer c userId [destSrv]
+  atomically (getClientVar proxySrv) >>= \(tSess, auth, v) ->
+    either (newProxyClient tSess auth) (waitForProxyClient tSess auth) v
+  where
+    getClientVar :: SMPServerWithAuth -> STM (SMPTransportSession, Maybe SMP.BasicAuth, Either SMPClientVar SMPClientVar)
+    getClientVar proxySrv = do
+      ProtoServerWithAuth srv auth <- TM.lookup destSess smpProxiedRelays >>= maybe (TM.insert destSess proxySrv smpProxiedRelays $> proxySrv) pure
+      let tSess = (userId, srv, qId)
+      (tSess,auth,) <$> getSessVar workerSeq tSess smpClients
+    newProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
+    newProxyClient tSess auth v = do
+      (prs, rv) <- atomically $ do
+        prs <- TM.empty
+        -- we do not need to check if it is a new proxied relay session,
+        -- as the client is just created and there are no sessions yet
+        (prs,) . either id id <$> getSessVar workerSeq destSrv prs
+      clnt <- smpConnectClient c tSess prs v
+      (clnt,) <$> newProxiedRelay clnt auth rv
+    waitForProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
+    waitForProxyClient tSess auth v = do
+      clnt@(SMPConnectedClient _ prs) <- waitForProtocolClient c tSess v
+      sess <-
+        atomically (getSessVar workerSeq destSrv prs)
+          >>= either (newProxiedRelay clnt auth) (waitForProxiedRelay tSess)
+      pure (clnt, sess)
+    newProxiedRelay :: SMPConnectedClient -> Maybe SMP.BasicAuth -> ProxiedRelayVar -> AM (Either AgentErrorType ProxiedRelay)
+    newProxiedRelay clnt@(SMPConnectedClient smp prs) proxyAuth rv =
+      tryAgentError (liftClient SMP (clientServer smp) $ connectSMPProxiedRelay smp destSrv proxyAuth) >>= \case
+        Right sess -> do
+          atomically $ putTMVar (sessionVar rv) (Right sess)
+          liftIO $ incClientStat c userId clnt "PROXY" "OK"
+          pure $ Right sess
+        Left e -> do
+          liftIO $ incClientStat c userId clnt "PROXY" $ strEncode e
+          atomically $ do
+            unless (serverHostError e) $ do
+              removeSessVar rv destSrv prs
+              TM.delete destSess smpProxiedRelays
+            putTMVar (sessionVar rv) (Left e)
+            pure $ Left e
+    waitForProxiedRelay :: SMPTransportSession -> ProxiedRelayVar -> AM (Either AgentErrorType ProxiedRelay)
+    waitForProxiedRelay (_, srv, _) rv = do
+      NetworkConfig {tcpConnectTimeout} <- atomically $ getNetworkConfig c
+      sess_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar rv)
+      pure $ case sess_ of
+        Just (Right sess) -> Right sess
+        Just (Left e) -> Left e
+        Nothing -> Left $ BROKER (B.unpack $ strEncode srv) TIMEOUT
+
+smpConnectClient :: AgentClient -> SMPTransportSession -> TMap SMPServer ProxiedRelayVar -> SMPClientVar -> AM SMPConnectedClient
+smpConnectClient c@AgentClient {smpClients, msgQ} tSess@(_, srv, _) prs v =
+  newProtocolClient c tSess smpClients connectClient v
+    `catchAgentError` \e -> lift (resubscribeSMPSession c tSess) >> throwError e
+  where
+    connectClient :: SMPClientVar -> AM SMPConnectedClient
+    connectClient v' = do
      cfg <- lift $ getClientConfig c smpCfg
      g <- asks random
      env <- ask
-      liftError' (protocolClientError SMP $ B.unpack $ strEncode srv) $
-        getProtocolClient g tSess cfg (Just msgQ) $
-          clientDisconnected env v
+      liftError (protocolClientError SMP $ B.unpack $ strEncode srv) $ do
+        smp <- ExceptT $ getProtocolClient g tSess cfg (Just msgQ) $ smpClientDisconnected c tSess env v' prs
+        pure SMPConnectedClient {connectedClient = smp, proxiedRelays = prs}

-    clientDisconnected :: Env -> SMPClientVar -> SMPClient -> IO ()
-    clientDisconnected env v client = do
-      removeClientAndSubs >>= serverDown
-      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
+smpClientDisconnected :: AgentClient -> SMPTransportSession -> Env -> SMPClientVar -> TMap SMPServer ProxiedRelayVar -> SMPClient -> IO ()
+smpClientDisconnected c@AgentClient {active, smpClients, smpProxiedRelays} tSess@(userId, srv, qId) env v prs client = do
+  removeClientAndSubs >>= serverDown
+  logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
+  where
+    -- we make active subscriptions pending only if the client for tSess was current (in the map) and active,
+    -- because we can have a race condition when a new current client could have already
+    -- made subscriptions active, and the old client would be processing diconnection later.
+    removeClientAndSubs :: IO ([RcvQueue], [ConnId])
+    removeClientAndSubs = atomically $ ifM currentActiveClient removeSubs $ pure ([], [])
      where
-        -- we make active subscriptions pending only if the client for tSess was current (in the map) and active,
-        -- because we can have a race condition when a new current client could have already
-        -- made subscriptions active, and the old client would be processing diconnection later.
-        removeClientAndSubs :: IO ([RcvQueue], [ConnId])
-        removeClientAndSubs = atomically $ ifM currentActiveClient removeSubs $ pure ([], [])
-          where
-            currentActiveClient = (&&) <$> removeSessVar' v tSess smpClients <*> readTVar active
-            removeSubs = do
-              (qs, cs) <- RQ.getDelSessQueues tSess $ activeSubs c
-              RQ.batchAddQueues (pendingSubs c) qs
-              pure (qs, cs)
+        currentActiveClient = (&&) <$> removeSessVar' v tSess smpClients <*> readTVar active
+        removeSubs = do
+          (qs, cs) <- RQ.getDelSessQueues tSess $ activeSubs c
+          RQ.batchAddQueues (pendingSubs c) qs
+          -- this removes proxied relays that this client created sessions to
+          destSrvs <- M.keys <$> readTVar prs
+          forM_ destSrvs $ \destSrv -> TM.delete (userId, destSrv, qId) smpProxiedRelays
+          pure (qs, cs)

-        serverDown :: ([RcvQueue], [ConnId]) -> IO ()
-        serverDown (qs, conns) = whenM (readTVarIO active) $ do
-          incClientStat c userId client "DISCONNECT" ""
-          notifySub "" $ hostEvent DISCONNECT client
-          unless (null conns) $ notifySub "" $ DOWN srv conns
-          unless (null qs) $ do
-            atomically $ mapM_ (releaseGetLock c) qs
-            runReaderT (resubscribeSMPSession c tSess) env
+    serverDown :: ([RcvQueue], [ConnId]) -> IO ()
+    serverDown (qs, conns) = whenM (readTVarIO active) $ do
+      incClientStat' c userId client "DISCONNECT" ""
+      notifySub "" $ hostEvent' DISCONNECT client
+      unless (null conns) $ notifySub "" $ DOWN srv conns
+      unless (null qs) $ do
+        atomically $ mapM_ (releaseGetLock c) qs
+        runReaderT (resubscribeSMPSession c tSess) env

-        notifySub :: forall e. AEntityI e => ConnId -> ACommand 'Agent e -> IO ()
-        notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, APC (sAEntity @e) cmd)
+    notifySub :: forall e. AEntityI e => ConnId -> ACommand 'Agent e -> IO ()
+    notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, APC (sAEntity @e) cmd)

 resubscribeSMPSession :: AgentClient -> SMPTransportSession -> AM' ()
 resubscribeSMPSession c@AgentClient {smpSubWorkers, workerSeq} tSess =
@@ -750,7 +833,11 @@ newProtocolClient c tSess@(userId, srv, entityId_) clients connectClient v =
      throwError e -- signal error to caller

 hostEvent :: forall v err msg. (ProtocolTypeI (ProtoType msg), ProtocolServerClient v err msg) => (AProtocolType -> TransportHost -> ACommand 'Agent 'AENone) -> Client msg -> ACommand 'Agent 'AENone
-hostEvent event = event (AProtocolType $ protocolTypeI @(ProtoType msg)) . clientTransportHost
+hostEvent event = hostEvent' event . protocolClient
+{-# INLINE hostEvent #-}
+
+hostEvent' :: forall v err msg. (ProtocolTypeI (ProtoType msg), ProtocolServerClient v err msg) => (AProtocolType -> TransportHost -> ACommand 'Agent 'AENone) -> ProtoClient msg -> ACommand 'Agent 'AENone
+hostEvent' event = event (AProtocolType $ protocolTypeI @(ProtoType msg)) . clientTransportHost

 getClientConfig :: AgentClient -> (AgentConfig -> ProtocolClientConfig v) -> AM' (ProtocolClientConfig v)
 getClientConfig c cfgSel = do
@@ -805,6 +892,7 @@ closeAgentClient c = do
  closeProtocolServerClients c smpClients
  closeProtocolServerClients c ntfClients
  closeProtocolServerClients c xftpClients
+  atomically $ writeTVar (smpProxiedRelays c) M.empty
  atomically (swapTVar (smpSubWorkers c) M.empty) >>= mapM_ cancelReconnect
  clearWorkers smpDeliveryWorkers >>= mapM_ (cancelWorker . fst)
  clearWorkers asyncCmdWorkers >>= mapM_ cancelWorker
@@ -857,7 +945,7 @@ closeClient_ c v = do
  NetworkConfig {tcpConnectTimeout} <- atomically $ getNetworkConfig c
  E.handle (\BlockedIndefinitelyOnSTM -> pure ()) $
    tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar v) >>= \case
-      Just (Right client) -> closeProtocolServerClient client `catchAll_` pure ()
+      Just (Right client) -> closeProtocolServerClient (protocolClient client) `catchAll_` pure ()
      _ -> pure ()

 closeXFTPServerClient :: AgentClient -> UserId -> XFTPServer -> FileDigest -> IO ()
@@ -910,6 +998,25 @@ withClient_ c tSess@(userId, srv, _) statCmd action = do
      stat cl $ strEncode e
      throwError e

+withProxySession :: AgentClient -> SMPTransportSession -> SMP.SenderId -> ByteString -> ((SMPConnectedClient, ProxiedRelay) -> AM a) -> AM a
+withProxySession c destSess@(userId, destSrv, _) entId cmdStr action = do
+  (cl, sess_) <- getSMPProxyClient c destSess
+  logServer ("--> " <> proxySrv cl <> " >") c destSrv entId cmdStr
+  case sess_ of
+    Right sess -> do
+      r <- (action (cl, sess) <* stat cl "OK") `catchAgentError` logServerError cl
+      logServer ("<-- " <> proxySrv cl <> " <") c destSrv entId "OK"
+      pure r
+    Left e -> logServerError cl e
+  where
+    stat cl = liftIO . incClientStat c userId cl cmdStr
+    proxySrv = showServer . protocolClientServer' . protocolClient
+    logServerError :: SMPConnectedClient -> AgentErrorType -> AM a
+    logServerError cl e = do
+      logServer ("<-- " <> proxySrv cl <> " <") c destSrv "" $ strEncode e
+      stat cl $ strEncode e
+      throwError e
+
 withLogClient_ :: ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> EntityId -> ByteString -> (Client msg -> AM a) -> AM a
 withLogClient_ c tSess@(_, srv, _) entId cmdStr action = do
  logServer "-->" c srv entId cmdStr
@@ -918,22 +1025,64 @@ withLogClient_ c tSess@(_, srv, _) entId cmdStr action = do
  return res

 withClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> ByteString -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
-withClient c tSess statKey action = withClient_ c tSess statKey $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer client) $ action client
+withClient c tSess statKey action = withClient_ c tSess statKey $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer $ protocolClient client) $ action client
 {-# INLINE withClient #-}

 withLogClient :: forall v err msg a. ProtocolServerClient v err msg => AgentClient -> TransportSession msg -> EntityId -> ByteString -> (Client msg -> ExceptT (ProtocolClientError err) IO a) -> AM a
-withLogClient c tSess entId cmdStr action = withLogClient_ c tSess entId cmdStr $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer client) $ action client
+withLogClient c tSess entId cmdStr action = withLogClient_ c tSess entId cmdStr $ \client -> liftClient (clientProtocolError @v @err @msg) (clientServer $ protocolClient client) $ action client
 {-# INLINE withLogClient #-}

 withSMPClient :: SMPQueueRec q => AgentClient -> q -> ByteString -> (SMPClient -> ExceptT SMPClientError IO a) -> AM a
 withSMPClient c q cmdStr action = do
  tSess <- liftIO $ mkSMPTransportSession c q
-  withLogClient c tSess (queueId q) cmdStr action
+  withLogClient c tSess (queueId q) cmdStr $ action . connectedClient

-withSMPClient_ :: SMPQueueRec q => AgentClient -> q -> ByteString -> (SMPClient -> AM a) -> AM a
-withSMPClient_ c q cmdStr action = do
-  tSess <- liftIO $ mkSMPTransportSession c q
-  withLogClient_ c tSess (queueId q) cmdStr action
+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
+  sess <- liftIO $ mkTransportSession c userId destSrv senderId
+  ifM (atomically shouldUseProxy) (sendViaProxy sess) (sendDirectly sess $> Nothing)
+  where
+    shouldUseProxy = do
+      cfg <- getNetworkConfig c
+      case smpProxyMode cfg of
+        SPMAlways -> pure True
+        SPMUnknown -> unknownServer
+        SPMUnprotected
+          | ipAddressProtected cfg destSrv -> pure False
+          | otherwise -> unknownServer
+        SPMNever -> pure False
+    directAllowed = do
+      cfg <- getNetworkConfig c
+      pure $ case smpProxyFallback cfg of
+        SPFAllow -> True
+        SPFAllowProtected -> ipAddressProtected cfg destSrv
+        SPFProhibit -> False
+    unknownServer = maybe True (all ((destSrv /=) . protoServer)) <$> TM.lookup userId (userServers c)
+    sendViaProxy destSess = do
+      r <- tryAgentError . withProxySession c destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess) -> do
+        liftClient SMP (clientServer smp) (proxySMPMessage smp proxySess spKey_ senderId msgFlags msg) >>= \case
+          Right () -> pure . Just $ protocolClientServer' smp
+          Left proxyErr ->
+            throwE
+              PROXY
+                { proxyServer = protocolClientServer smp,
+                  relayServer = B.unpack $ strEncode destSrv,
+                  proxyErr
+                }
+      case r of
+        Right r' -> pure r'
+        Left e
+          | serverHostError e -> ifM (atomically directAllowed) (sendDirectly destSess $> Nothing) (throwE e)
+          | otherwise -> throwE e
+    sendDirectly tSess =
+      withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) ->
+        liftClient SMP (clientServer smp) $ sendSMPMessage smp spKey_ senderId msgFlags msg
+
+ipAddressProtected :: NetworkConfig -> ProtocolServer p -> Bool
+ipAddressProtected NetworkConfig {socksProxy, hostMode} (ProtocolServer _ hosts _ _) = do
+  isJust socksProxy || (hostMode == HMOnion && any isOnionHost hosts)
+  where
+    isOnionHost = \case THOnionHost _ -> True; _ -> False

 withNtfClient :: AgentClient -> NtfServer -> EntityId -> ByteString -> (NtfClient -> ExceptT NtfClientError IO a) -> AM a
 withNtfClient c srv = withLogClient c (0, srv, Nothing)
@@ -957,7 +1106,7 @@ protocolClientError :: (Show err, Encoding err) => (HostName -> err -> AgentErro
 protocolClientError protocolError_ host = \case
  PCEProtocolError e -> protocolError_ host e
  PCEResponseError e -> BROKER host $ RESPONSE $ B.unpack $ smpEncode e
-  PCEUnexpectedResponse _ -> BROKER host UNEXPECTED
+  PCEUnexpectedResponse r -> BROKER host $ UNEXPECTED $ take 32 $ show r
  PCEResponseTimeout -> BROKER host TIMEOUT
  PCENetworkError -> BROKER host NETWORK
  PCEIncompatibleHost -> BROKER host HOST
@@ -1004,7 +1153,6 @@ runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
          liftError (testErr TSSecureQueue) $ secureSMPQueue smp rpKey rcvId sKey
          liftError (testErr TSDeleteQueue) $ deleteSMPQueue smp rpKey rcvId
        ok <- tcpTimeout (networkConfig cfg) `timeout` closeProtocolClient smp
-        incClientStat c userId smp "SMP_TEST" "OK"
        pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
      Left e -> pure (Just $ testErr TSConnect e)
  where
@@ -1119,7 +1267,7 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
  logServer "-->" c srv "" "NEW"
  tSess <- liftIO $ mkTransportSession c userId srv connId
  (sessId, QIK {rcvId, sndId, rcvPublicDhKey}) <-
-    withClient c tSess "NEW" $ \smp ->
+    withClient c tSess "NEW" $ \(SMPConnectedClient smp _) ->
      (sessionId $ thParams smp,) <$> createSMPQueue smp rKeys dhKey auth subMode
  liftIO . logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
  let rq =
@@ -1157,18 +1305,33 @@ processSubResult c rq@RcvQueue {connId} = \case

 temporaryAgentError :: AgentErrorType -> Bool
 temporaryAgentError = \case
-  BROKER _ NETWORK -> True
-  BROKER _ TIMEOUT -> True
+  BROKER _ e -> tempBrokerError e
+  SMP _ (SMP.PROXY (SMP.BROKER e)) -> tempBrokerError e
+  PROXY _ _ (ProxyProtocolError (SMP.PROXY (SMP.BROKER e))) -> tempBrokerError e
  INACTIVE -> True
  _ -> False
-{-# INLINE temporaryAgentError #-}
+  where
+    tempBrokerError = \case
+      NETWORK -> True
+      TIMEOUT -> True
+      _ -> False

 temporaryOrHostError :: AgentErrorType -> Bool
-temporaryOrHostError = \case
-  BROKER _ HOST -> True
-  e -> temporaryAgentError e
+temporaryOrHostError e = temporaryAgentError e || serverHostError e
 {-# INLINE temporaryOrHostError #-}

+serverHostError :: AgentErrorType -> Bool
+serverHostError = \case
+  BROKER _ e -> brokerHostError e
+  SMP _ (SMP.PROXY (SMP.BROKER e)) -> brokerHostError e
+  PROXY _ _ (ProxyProtocolError (SMP.PROXY (SMP.BROKER e))) -> brokerHostError e
+  _ -> False
+  where
+    brokerHostError = \case
+      HOST -> True
+      SMP.TRANSPORT TEVersion -> True
+      _ -> False
+
 -- | Subscribe to queues. The list of results can have a different order.
 subscribeQueues :: AgentClient -> [RcvQueue] -> AM' ([(RcvQueue, Either AgentErrorType ())], Maybe SessionId)
 subscribeQueues c qs = do
@@ -1211,7 +1374,7 @@ activeClientSession :: AgentClient -> SMPTransportSession -> SessionId -> STM Bo
 activeClientSession c tSess sessId = sameSess <$> tryReadSessVar tSess (smpClients c)
  where
    sameSess = \case
-      Just (Right smp) -> sessId == sessionId (thParams smp)
+      Just (Right (SMPConnectedClient smp _)) -> sessId == sessionId (thParams smp)
      _ -> False

 type BatchResponses e r = NonEmpty (RcvQueue, Either e r)
@@ -1233,7 +1396,7 @@ sendTSessionBatches statCmd statBatchSize toRQ action c qs =
    sendClientBatch (tSess@(userId, srv, _), qs') =
      tryAgentError' (getSMPServerClient c tSess) >>= \case
        Left e -> pure $ L.map ((,Left e) . toRQ) qs'
-        Right smp -> liftIO $ do
+        Right (SMPConnectedClient smp _) -> liftIO $ do
          logServer "-->" c srv (bshow (length qs') <> " queues") statCmd
          rs <- L.map agentError <$> action smp qs'
          statBatch
@@ -1302,20 +1465,17 @@ logSecret :: ByteString -> ByteString
 logSecret bs = encode $ B.take 3 bs
 {-# INLINE logSecret #-}

-sendConfirmation :: AgentClient -> SndQueue -> ByteString -> AM ()
-sendConfirmation c sq@SndQueue {sndId, sndPublicKey = Just sndPublicKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation =
-  withSMPClient_ c sq "SEND <CONF>" $ \smp -> do
-    let clientMsg = SMP.ClientMessage (SMP.PHConfirmation sndPublicKey) agentConfirmation
-    msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
-    liftClient SMP (clientServer smp) $ sendSMPMessage smp Nothing sndId (SMP.MsgFlags {notification = True}) msg
+sendConfirmation :: AgentClient -> SndQueue -> ByteString -> AM (Maybe SMPServer)
+sendConfirmation c sq@SndQueue {userId, server, sndId, sndPublicKey = Just sndPublicKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = do
+  let clientMsg = SMP.ClientMessage (SMP.PHConfirmation sndPublicKey) agentConfirmation
+  msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
+  sendOrProxySMPMessage c userId server "<CONF>" Nothing sndId (MsgFlags {notification = True}) msg
 sendConfirmation _ _ _ = throwError $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"

-sendInvitation :: AgentClient -> UserId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM ()
+sendInvitation :: AgentClient -> UserId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM (Maybe SMPServer)
 sendInvitation c userId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) connReq connInfo = do
-  tSess <- liftIO $ mkTransportSession c userId smpServer senderId
-  withLogClient_ c tSess senderId "SEND <INV>" $ \smp -> do
-    msg <- mkInvitation
-    liftClient SMP (clientServer smp) $ sendSMPMessage smp Nothing senderId MsgFlags {notification = True} msg
+  msg <- mkInvitation
+  sendOrProxySMPMessage c userId smpServer "<INV>" Nothing senderId (MsgFlags {notification = True}) msg
  where
    mkInvitation :: AM ByteString
    -- this is only encrypted with per-queue E2E, not with double ratchet
@@ -1399,12 +1559,11 @@ deleteQueue c rq@RcvQueue {rcvId, rcvPrivateKey} = do
 deleteQueues :: AgentClient -> [RcvQueue] -> AM' [(RcvQueue, Either AgentErrorType ())]
 deleteQueues = sendTSessionBatches "DEL" 90 id $ sendBatch deleteSMPQueues

-sendAgentMessage :: AgentClient -> SndQueue -> MsgFlags -> ByteString -> AM ()
-sendAgentMessage c sq@SndQueue {sndId, sndPrivateKey} msgFlags agentMsg =
-  withSMPClient_ c sq "SEND <MSG>" $ \smp -> do
-    let clientMsg = SMP.ClientMessage SMP.PHEmpty agentMsg
-    msg <- agentCbEncrypt sq Nothing $ smpEncode clientMsg
-    liftClient SMP (clientServer smp) $ sendSMPMessage smp (Just sndPrivateKey) sndId msgFlags msg
+sendAgentMessage :: AgentClient -> SndQueue -> MsgFlags -> ByteString -> AM (Maybe SMPServer)
+sendAgentMessage c sq@SndQueue {userId, server, sndId, sndPrivateKey} msgFlags agentMsg = do
+  let clientMsg = SMP.ClientMessage SMP.PHEmpty agentMsg
+  msg <- agentCbEncrypt sq Nothing $ smpEncode clientMsg
+  sendOrProxySMPMessage c userId server "<MSG>" (Just sndPrivateKey) sndId msgFlags msg

 agentNtfRegisterToken :: AgentClient -> NtfToken -> NtfPublicAuthKey -> C.PublicKeyX25519 -> AM (NtfTokenId, C.PublicKeyX25519)
 agentNtfRegisterToken c NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =
@@ -1672,9 +1831,13 @@ incStat AgentClient {agentStats} n k = do
    _ -> newTVar n >>= \v -> TM.insert k v agentStats

 incClientStat :: ProtocolServerClient v err msg => AgentClient -> UserId -> Client msg -> ByteString -> ByteString -> IO ()
-incClientStat c userId pc = incClientStatN c userId pc 1
+incClientStat c userId = incClientStat' c userId . protocolClient
 {-# INLINE incClientStat #-}

+incClientStat' :: ProtocolServerClient v err msg => AgentClient -> UserId -> ProtoClient msg -> ByteString -> ByteString -> IO ()
+incClientStat' c userId pc = incClientStatN c userId pc 1
+{-# INLINE incClientStat' #-}
+
 incServerStat :: AgentClient -> UserId -> ProtocolServer p -> ByteString -> ByteString -> IO ()
 incServerStat c userId ProtocolServer {host} cmd res = do
  threadDelay 100000
@@ -1682,7 +1845,7 @@ incServerStat c userId ProtocolServer {host} cmd res = do
  where
    statsKey = AgentStatsKey {userId, host = strEncode $ L.head host, clientTs = "", cmd, res}

-incClientStatN :: ProtocolServerClient v err msg => AgentClient -> UserId -> Client msg -> Int -> ByteString -> ByteString -> IO ()
+incClientStatN :: ProtocolServerClient v err msg => AgentClient -> UserId -> ProtoClient msg -> Int -> ByteString -> ByteString -> IO ()
 incClientStatN c userId pc n cmd res = do
  atomically $ incStat c n statsKey
  where
@@ -189,6 +189,7 @@ import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Protocol (FileParty (..))
 import Simplex.FileTransfer.Transport (XFTPErrorType)
 import Simplex.Messaging.Agent.QueryString
+import Simplex.Messaging.Client (ProxyClientError)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet
  ( InitialKeys (..),
@@ -206,6 +207,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol
  ( AProtocolType,
+    BrokerErrorType (..),
    EntityId,
    ErrorType,
    MsgBody,
@@ -233,7 +235,7 @@ import Simplex.Messaging.Protocol
  )
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme
-import Simplex.Messaging.Transport (Transport (..), TransportError, serializeTransportError, transportErrorP)
+import Simplex.Messaging.Transport (Transport (..))
 import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts_ (..))
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
@@ -393,7 +395,8 @@ data ACommand (p :: AParty) (e :: AEntity) where
  RSYNC :: RatchetSyncState -> Maybe AgentCryptoError -> ConnectionStats -> ACommand Agent AEConn
  SEND :: PQEncryption -> MsgFlags -> MsgBody -> ACommand Client AEConn
  MID :: AgentMsgId -> PQEncryption -> ACommand Agent AEConn
-  SENT :: AgentMsgId -> ACommand Agent AEConn
+  SENT :: AgentMsgId -> Maybe SMPServer -> ACommand Agent AEConn
+  MWARN :: AgentMsgId -> AgentErrorType -> ACommand Agent AEConn
  MERR :: AgentMsgId -> AgentErrorType -> ACommand Agent AEConn
  MERRS :: NonEmpty AgentMsgId -> AgentErrorType -> ACommand Agent AEConn
  MSG :: MsgMeta -> MsgFlags -> MsgBody -> ACommand Agent AEConn
@@ -457,6 +460,7 @@ data ACommandTag (p :: AParty) (e :: AEntity) where
  SEND_ :: ACommandTag Client AEConn
  MID_ :: ACommandTag Agent AEConn
  SENT_ :: ACommandTag Agent AEConn
+  MWARN_ :: ACommandTag Agent AEConn
  MERR_ :: ACommandTag Agent AEConn
  MERRS_ :: ACommandTag Agent AEConn
  MSG_ :: ACommandTag Agent AEConn
@@ -512,7 +516,8 @@ aCommandTag = \case
  RSYNC {} -> RSYNC_
  SEND {} -> SEND_
  MID {} -> MID_
-  SENT _ -> SENT_
+  SENT {} -> SENT_
+  MWARN {} -> MWARN_
  MERR {} -> MERR_
  MERRS {} -> MERRS_
  MSG {} -> MSG_
@@ -1300,6 +1305,7 @@ instance VersionRangeI SMPClientVersion SMPQueueUri where
  type VersionT SMPClientVersion SMPQueueUri = SMPQueueInfo
  versionRange = clientVRange
  toVersionT (SMPQueueUri _vr addr) v = SMPQueueInfo v addr
+  toVersionRange (SMPQueueUri _vr addr) vr = SMPQueueUri vr addr

 -- | SMP queue information sent out-of-band.
 --
@@ -1474,6 +1480,8 @@ data AgentErrorType
    NTF {serverAddress :: String, ntfErr :: ErrorType}
  | -- | XFTP protocol errors forwarded to agent clients
    XFTP {serverAddress :: String, xftpErr :: XFTPErrorType}
+  | -- | SMP proxy errors
+    PROXY {proxyServer :: String, relayServer :: String, proxyErr :: ProxyClientError}
  | -- | XRCP protocol errors forwarded to agent clients
    RCP {rcpErr :: RCErrorType}
  | -- | SMP server errors
@@ -1516,22 +1524,6 @@ data ConnectionErrorType
    NOT_AVAILABLE
  deriving (Eq, Read, Show, Exception)

-- | SMP server errors.
-data BrokerErrorType
-  = -- | invalid server response (failed to parse)
-    RESPONSE {smpErr :: String}
-  | -- | unexpected response
-    UNEXPECTED
-  | -- | network error
-    NETWORK
-  | -- | no compatible server host (e.g. onion when public is required, or vice versa)
-    HOST
-  | -- | handshake or other transport error
-    TRANSPORT {transportErr :: TransportError}
-  | -- | command response timeout
-    TIMEOUT
-  deriving (Eq, Read, Show, Exception)
-
 -- | Errors of another SMP agent.
 data SMPAgentError
  = -- | client or agent message that failed to parse
@@ -1566,12 +1558,14 @@ data AgentCryptoError

 instance StrEncoding AgentCryptoError where
  strP =
-    "DECRYPT_AES" $> DECRYPT_AES
-      <|> "DECRYPT_CB" $> DECRYPT_CB
-      <|> "RATCHET_HEADER" $> RATCHET_HEADER
-      <|> "RATCHET_EARLIER " *> (RATCHET_EARLIER <$> strP)
-      <|> "RATCHET_SKIPPED " *> (RATCHET_SKIPPED <$> strP)
-      <|> "RATCHET_SYNC" $> RATCHET_SYNC
+    A.takeTill (== ' ') >>= \case
+      "DECRYPT_AES" -> pure DECRYPT_AES
+      "DECRYPT_CB" -> pure DECRYPT_CB
+      "RATCHET_HEADER" -> pure RATCHET_HEADER
+      "RATCHET_EARLIER" -> RATCHET_EARLIER <$> _strP
+      "RATCHET_SKIPPED" -> RATCHET_SKIPPED <$> _strP
+      "RATCHET_SYNC" -> pure RATCHET_SYNC
+      _ -> fail "AgentCryptoError"
  strEncode = \case
    DECRYPT_AES -> "DECRYPT_AES"
    DECRYPT_CB -> "DECRYPT_CB"
@@ -1582,42 +1576,59 @@ instance StrEncoding AgentCryptoError where

 instance StrEncoding AgentErrorType where
  strP =
-    "CMD " *> (CMD <$> parseRead1)
-      <|> "CONN " *> (CONN <$> parseRead1)
-      <|> "SMP " *> (SMP <$> textP <*> _strP)
-      <|> "NTF " *> (NTF <$> textP <*> _strP)
-      <|> "XFTP " *> (XFTP <$> textP <*> _strP)
-      <|> "RCP " *> (RCP <$> strP)
-      <|> "BROKER " *> (BROKER <$> textP <* " RESPONSE " <*> (RESPONSE <$> textP))
-      <|> "BROKER " *> (BROKER <$> textP <* " TRANSPORT " <*> (TRANSPORT <$> transportErrorP))
-      <|> "BROKER " *> (BROKER <$> textP <* A.space <*> parseRead1)
-      <|> "AGENT CRYPTO " *> (AGENT . A_CRYPTO <$> parseRead A.takeByteString)
-      <|> "AGENT QUEUE " *> (AGENT . A_QUEUE <$> parseRead A.takeByteString)
-      <|> "AGENT " *> (AGENT <$> parseRead1)
-      <|> "INTERNAL " *> (INTERNAL <$> parseRead A.takeByteString)
-      <|> "CRITICAL " *> (CRITICAL <$> parseRead1 <* A.space <*> parseRead A.takeByteString)
-      <|> "INACTIVE" $> INACTIVE
+    A.takeTill (== ' ')
+      >>= \case
+        "CMD" -> CMD <$> (A.space *> parseRead1)
+        "CONN" -> CONN <$> (A.space *> parseRead1)
+        "SMP" -> SMP <$> (A.space *> srvP) <*> _strP
+        "NTF" -> NTF <$> (A.space *> srvP) <*> _strP
+        "XFTP" -> XFTP <$> (A.space *> srvP) <*> _strP
+        "PROXY" -> PROXY <$> (A.space *> srvP) <* A.space <*> srvP <*> _strP
+        "RCP" -> RCP <$> _strP
+        "BROKER" -> BROKER <$> (A.space *> srvP) <*> _strP
+        "AGENT" -> AGENT <$> _strP
+        "INTERNAL" -> INTERNAL <$> (A.space *> textP)
+        "CRITICAL" -> CRITICAL <$> (A.space *> parseRead1) <*> (A.space *> textP)
+        "INACTIVE" -> pure INACTIVE
+        _ -> fail "bad AgentErrorType"
    where
-      textP = T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' ')
+      srvP = T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' ')
+      textP = T.unpack . safeDecodeUtf8 <$> A.takeByteString
  strEncode = \case
    CMD e -> "CMD " <> bshow e
    CONN e -> "CONN " <> bshow e
    SMP srv e -> "SMP " <> text srv <> " " <> strEncode e
    NTF srv e -> "NTF " <> text srv <> " " <> strEncode e
    XFTP srv e -> "XFTP " <> text srv <> " " <> strEncode e
+    PROXY pxy srv e -> B.unwords ["PROXY", text pxy, text srv, strEncode e]
    RCP e -> "RCP " <> strEncode e
-    BROKER srv (RESPONSE e) -> "BROKER " <> text srv <> " RESPONSE " <> text e
-    BROKER srv (TRANSPORT e) -> "BROKER " <> text srv <> " TRANSPORT " <> serializeTransportError e
-    BROKER srv e -> "BROKER " <> text srv <> " " <> bshow e
-    AGENT (A_CRYPTO e) -> "AGENT CRYPTO " <> bshow e
-    AGENT (A_QUEUE e) -> "AGENT QUEUE " <> bshow e
-    AGENT e -> "AGENT " <> bshow e
-    INTERNAL e -> "INTERNAL " <> bshow e
-    CRITICAL restart e -> "CRITICAL " <> bshow restart <> " " <> bshow e
+    BROKER srv e -> B.unwords ["BROKER", text srv, strEncode e]
+    AGENT e -> "AGENT " <> strEncode e
+    INTERNAL e -> "INTERNAL " <> encodeUtf8 (T.pack e)
+    CRITICAL restart e -> "CRITICAL " <> bshow restart <> " " <> encodeUtf8 (T.pack e)
    INACTIVE -> "INACTIVE"
    where
      text = encodeUtf8 . T.pack

+instance StrEncoding SMPAgentError where
+  strP =
+    A.takeTill (== ' ')
+      >>= \case
+        "MESSAGE" -> pure A_MESSAGE
+        "PROHIBITED" -> pure A_PROHIBITED
+        "VERSION" -> pure A_VERSION
+        "CRYPTO" -> A_CRYPTO <$> _strP
+        "DUPLICATE" -> pure A_DUPLICATE
+        "QUEUE" -> A_QUEUE . T.unpack . safeDecodeUtf8 <$> (A.space *> A.takeByteString)
+        _ -> fail "bad SMPAgentError"
+  strEncode = \case
+    A_MESSAGE -> "MESSAGE"
+    A_PROHIBITED -> "PROHIBITED"
+    A_VERSION -> "VERSION"
+    A_CRYPTO e -> "CRYPTO " <> strEncode e
+    A_DUPLICATE -> "DUPLICATE"
+    A_QUEUE e -> "QUEUE " <> encodeUtf8 (T.pack e)
+
 cryptoErrToSyncState :: AgentCryptoError -> RatchetSyncState
 cryptoErrToSyncState = \case
  DECRYPT_AES -> RSAllowed
@@ -1660,6 +1671,7 @@ instance StrEncoding ACmdTag where
      "SEND" -> t SEND_
      "MID" -> ct MID_
      "SENT" -> ct SENT_
+      "MWARN" -> ct MWARN_
      "MERR" -> ct MERR_
      "MERRS" -> ct MERRS_
      "MSG" -> ct MSG_
@@ -1718,6 +1730,7 @@ instance (APartyI p, AEntityI e) => StrEncoding (ACommandTag p e) where
    SEND_ -> "SEND"
    MID_ -> "MID"
    SENT_ -> "SENT"
+    MWARN_ -> "MWARN"
    MERR_ -> "MERR"
    MERRS_ -> "MERRS"
    MSG_ -> "MSG"
@@ -1788,7 +1801,8 @@ commandP binaryP =
          SWITCH_ -> s (SWITCH <$> strP_ <*> strP_ <*> strP)
          RSYNC_ -> s (RSYNC <$> strP_ <*> strP <*> strP)
          MID_ -> s (MID <$> A.decimal <*> _strP)
-          SENT_ -> s (SENT <$> A.decimal)
+          SENT_ -> s (SENT <$> A.decimal <*> _strP)
+          MWARN_ -> s (MWARN <$> A.decimal <* A.space <*> strP)
          MERR_ -> s (MERR <$> A.decimal <* A.space <*> strP)
          MERRS_ -> s (MERRS <$> strP_ <*> strP)
          MSG_ -> s (MSG <$> strP <* A.space <*> smpP <* A.space <*> binaryP)
@@ -1851,7 +1865,8 @@ serializeCommand = \case
  RSYNC rrState cryptoErr cstats -> s (RSYNC_, rrState, cryptoErr, cstats)
  SEND pqEnc msgFlags msgBody -> B.unwords [s SEND_, s pqEnc, smpEncode msgFlags, serializeBinary msgBody]
  MID mId pqEnc -> s (MID_, mId, pqEnc)
-  SENT mId -> s (SENT_, mId)
+  SENT mId proxySrv_ -> s (SENT_, mId, proxySrv_)
+  MWARN mId e -> s (MWARN_, mId, e)
  MERR mId e -> s (MERR_, mId, e)
  MERRS mIds e -> s (MERRS_, mIds, e)
  MSG msgMeta msgFlags msgBody -> B.unwords [s MSG_, s msgMeta, smpEncode msgFlags, serializeBinary msgBody]
@@ -1977,8 +1992,6 @@ $(J.deriveJSON (sumTypeJSON id) ''CommandErrorType)

 $(J.deriveJSON (sumTypeJSON id) ''ConnectionErrorType)

-$(J.deriveJSON (sumTypeJSON id) ''BrokerErrorType)
-
 $(J.deriveJSON (sumTypeJSON id) ''AgentCryptoError)

 $(J.deriveJSON (sumTypeJSON id) ''SMPAgentError)
@@ -30,9 +30,11 @@ module Simplex.Messaging.Client
    TransportSession,
    ProtocolClient (thParams, sessionTs),
    SMPClient,
+    ProxiedRelay (..),
    getProtocolClient,
    closeProtocolClient,
    protocolClientServer,
+    protocolClientServer',
    transportHost',
    transportSession',

@@ -54,14 +56,22 @@ module Simplex.Messaging.Client
    suspendSMPQueue,
    deleteSMPQueue,
    deleteSMPQueues,
+    connectSMPProxiedRelay,
+    proxySMPMessage,
+    forwardSMPMessage,
    sendProtocolCommand,

    -- * Supporting types and client configuration
    ProtocolClientError (..),
    SMPClientError,
+    ProxyClientError (..),
    ProtocolClientConfig (..),
    NetworkConfig (..),
    TransportSessionMode (..),
+    HostMode (..),
+    SocksMode (..),
+    SMPProxyMode (..),
+    SMPProxyFallback (..),
    defaultClientConfig,
    defaultSMPClientConfig,
    defaultNetworkConfig,
@@ -69,6 +79,7 @@ module Simplex.Messaging.Client
    chooseTransportHost,
    proxyUsername,
    temporaryClientError,
+    smpProxyError,
    ServerTransmission,
    TransmissionType (..),
    ClientCommand,
@@ -92,6 +103,7 @@ import Control.Monad.IO.Class (liftIO)
 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.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
@@ -101,9 +113,12 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
 import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime)
+import qualified Data.X509 as X
+import qualified Data.X509.Validation as XV
 import Network.Socket (ServiceName)
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
 import Simplex.Messaging.Protocol
@@ -113,7 +128,7 @@ import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client (SocksProxy, TransportClientConfig (..), TransportHost (..), defaultTcpConnectTimeout, runTransportClient)
 import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Transport.WebSockets (WS)
-import Simplex.Messaging.Util (bshow, diffToMicroseconds, ifM, raceAny_, threadDelay', tshow, whenM)
+import Simplex.Messaging.Util (bshow, diffToMicroseconds, ifM, liftEitherWith, raceAny_, threadDelay', tshow, whenM)
 import Simplex.Messaging.Version
 import System.Timeout (timeout)

@@ -131,6 +146,7 @@ data PClient v err msg = PClient
  { connected :: TVar Bool,
    transportSession :: TransportSession msg,
    transportHost :: TransportHost,
+    tcpConnectTimeout :: Int,
    tcpTimeout :: Int,
    sendPings :: TVar Bool,
    lastReceived :: TVar UTCTime,
@@ -160,6 +176,7 @@ smpClientStub g sessionId thVersion thAuth = do
          THandleParams
            { sessionId,
              thVersion,
+              thServerVRange = supportedServerSMPRelayVRange,
              thAuth,
              blockSize = smpBlockSize,
              implySessId = thVersion >= authCmdsSMPVersion,
@@ -171,6 +188,7 @@ smpClientStub g sessionId thVersion thAuth = do
            { connected,
              transportSession = (1, "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001", Nothing),
              transportHost = "localhost",
+              tcpConnectTimeout = 20_000_000,
              tcpTimeout = 15_000_000,
              sendPings,
              lastReceived,
@@ -202,16 +220,30 @@ data HostMode
    HMPublic
  deriving (Eq, Show)

+data SocksMode
+  = -- | always use SOCKS proxy when enabled
+    SMAlways
+  | -- | use SOCKS proxy only for .onion hosts when no public host is available
+    -- This mode is used in SMP proxy to minimize SOCKS proxy usage.
+    SMOnion
+  deriving (Eq, Show)
+
 -- | network configuration for the client
 data NetworkConfig = NetworkConfig
  { -- | use SOCKS5 proxy
    socksProxy :: Maybe SocksProxy,
+    -- | when to use SOCKS proxy
+    socksMode :: SocksMode,
    -- | determines critera which host is chosen from the list
    hostMode :: HostMode,
    -- | if above criteria is not met, if the below setting is True return error, otherwise use the first host
    requiredHostMode :: Bool,
    -- | transport sessions are created per user or per entity
    sessionMode :: TransportSessionMode,
+    -- | SMP proxy mode
+    smpProxyMode :: SMPProxyMode,
+    -- | Fallback to direct connection when destination SMP relay does not support SMP proxy protocol extensions
+    smpProxyFallback :: SMPProxyFallback,
    -- | timeout for the initial client TCP/TLS connection (microseconds)
    tcpConnectTimeout :: Int,
    -- | timeout of protocol commands (microseconds)
@@ -233,13 +265,30 @@ data NetworkConfig = NetworkConfig
 data TransportSessionMode = TSMUser | TSMEntity
  deriving (Eq, Show)

+-- SMP proxy mode for sending messages
+data SMPProxyMode
+  = SPMAlways
+  | SPMUnknown -- use with unknown relays
+  | SPMUnprotected -- use with unknown relays when IP address is not protected (i.e., when neither SOCKS proxy nor .onion address is used)
+  | SPMNever
+  deriving (Eq, Show)
+
+data SMPProxyFallback
+  = SPFAllow -- connect directly when chosen proxy or destination relay do not support proxy protocol.
+  | SPFAllowProtected -- connect directly only when IP address is protected (SOCKS proxy or .onion address is used).
+  | SPFProhibit -- prohibit direct connection to destination relay.
+  deriving (Eq, Show)
+
 defaultNetworkConfig :: NetworkConfig
 defaultNetworkConfig =
  NetworkConfig
    { socksProxy = Nothing,
+      socksMode = SMAlways,
      hostMode = HMOnionViaSocks,
      requiredHostMode = False,
      sessionMode = TSMUser,
+      smpProxyMode = SPMNever,
+      smpProxyFallback = SPFAllow,
      tcpConnectTimeout = defaultTcpConnectTimeout,
      tcpTimeout = 15_000_000,
      tcpTimeoutPerKb = 5_000,
@@ -250,9 +299,14 @@ defaultNetworkConfig =
      logTLSErrors = False
    }

-transportClientConfig :: NetworkConfig -> TransportClientConfig
-transportClientConfig NetworkConfig {socksProxy, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} =
-  TransportClientConfig {socksProxy, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, alpn = Nothing}
+transportClientConfig :: NetworkConfig -> TransportHost -> TransportClientConfig
+transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} host =
+  TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, alpn = Nothing}
+  where
+    useSocksProxy SMAlways = socksProxy
+    useSocksProxy SMOnion = case host of
+      THOnionHost _ -> socksProxy
+      _ -> Nothing
 {-# INLINE transportClientConfig #-}

 -- | protocol client configuration.
@@ -266,7 +320,7 @@ data ProtocolClientConfig v = ProtocolClientConfig
    clientALPN :: Maybe [ALPN],
    -- | client-server protocol version range
    serverVRange :: VersionRange v,
-    -- | agree shared session secret (used in SMP proxy)
+    -- | agree shared session secret (used in SMP proxy for additional encryption layer)
    agreeSecret :: Bool
  }

@@ -315,10 +369,14 @@ chooseTransportHost NetworkConfig {socksProxy, hostMode, requiredHostMode} hosts
    publicHost = find (not . isOnionHost) hosts

 protocolClientServer :: ProtocolTypeI (ProtoType msg) => ProtocolClient v err msg -> String
-protocolClientServer = B.unpack . strEncode . snd3 . transportSession . client_
+protocolClientServer = B.unpack . strEncode . protocolClientServer'
+{-# INLINE protocolClientServer #-}
+
+protocolClientServer' :: ProtocolClient v err msg -> ProtoServer msg
+protocolClientServer' = snd3 . transportSession . client_
  where
    snd3 (_, s, _) = s
-{-# INLINE protocolClientServer #-}
+{-# INLINE protocolClientServer' #-}

 transportHost' :: ProtocolClient v err msg -> TransportHost
 transportHost' = transportHost . client_
@@ -362,6 +420,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
          { connected,
            transportSession,
            transportHost,
+            tcpConnectTimeout,
            tcpTimeout,
            sendPings,
            lastReceived,
@@ -376,7 +435,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
    runClient :: (ServiceName, ATransport) -> TransportHost -> PClient v err msg -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
    runClient (port', ATransport t) useHost c = do
      cVar <- newEmptyTMVarIO
-      let tcConfig = (transportClientConfig networkConfig) {alpn = clientALPN}
+      let tcConfig = (transportClientConfig networkConfig useHost) {alpn = clientALPN}
          username = proxyUsername transportSession
      action <-
        async $
@@ -521,6 +580,19 @@ temporaryClientError = \case
  _ -> False
 {-# INLINE temporaryClientError #-}

+-- converts error of client running on proxy to the error sent to client connected to proxy
+smpProxyError :: SMPClientError -> ErrorType
+smpProxyError = \case
+  PCEProtocolError e -> PROXY $ PROTOCOL e
+  PCEResponseError e -> PROXY $ BROKER $ RESPONSE $ B.unpack $ strEncode e
+  PCEUnexpectedResponse s -> PROXY $ BROKER $ UNEXPECTED $ B.unpack $ B.take 32 s
+  PCEResponseTimeout -> PROXY $ BROKER TIMEOUT
+  PCENetworkError -> PROXY $ BROKER NETWORK
+  PCEIncompatibleHost -> PROXY $ BROKER HOST
+  PCETransportError t -> PROXY $ BROKER $ TRANSPORT t
+  PCECryptoError _ -> CRYPTO
+  PCEIOError _ -> INTERNAL
+
 -- | Create a new SMP queue.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#create-queue-command
@@ -674,6 +746,156 @@ deleteSMPQueues :: SMPClient -> NonEmpty (RcvPrivateAuthKey, RecipientId) -> IO
 deleteSMPQueues = okSMPCommands DEL
 {-# INLINE deleteSMPQueues #-}

+-- 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
+connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, tcpTimeout}} relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyAuth
+  | thVersion (thParams c) >= sendingProxySMPVersion =
+      sendProtocolCommand_ c Nothing tOut Nothing "" (Cmd SProxiedClient (PRXY relayServ proxyAuth)) >>= \case
+        PKEY sId vr (chain, key) ->
+          case supportedClientSMPRelayVRange `compatibleVersion` vr of
+            Nothing -> throwE $ transportErr TEVersion
+            Just (Compatible v) -> liftEitherWith (const $ transportErr $ TEHandshake IDENTITY) $ ProxiedRelay sId v <$> validateRelay chain key
+        r -> throwE . PCEUnexpectedResponse $ bshow r
+  | otherwise = throwE $ PCETransportError TEVersion
+  where
+    tOut = Just $ tcpConnectTimeout + tcpTimeout
+    transportErr = PCEProtocolError . PROXY . BROKER . TRANSPORT
+    validateRelay :: X.CertificateChain -> X.SignedExact X.PubKey -> Either String C.PublicKeyX25519
+    validateRelay (X.CertificateChain cert) exact = do
+      serverKey <- case cert of
+        [leaf, ca]
+          | XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 ->
+              C.x509ToPublic (X.certPubKey . X.signedObject $ X.getSigned leaf, []) >>= C.pubKey
+        _ -> throwError "bad certificate"
+      pubKey <- C.verifyX509 serverKey exact
+      C.x509ToPublic (pubKey, []) >>= C.pubKey
+
+data ProxiedRelay = ProxiedRelay
+  { prSessionId :: SessionId,
+    prVersion :: VersionSMP,
+    prServerKey :: C.PublicKeyX25519
+  }
+
+data ProxyClientError
+  = -- | protocol error response from proxy
+    ProxyProtocolError ErrorType
+  | -- | unexpexted response
+    ProxyUnexpectedResponse String
+  | -- | error between proxy and server
+    ProxyResponseError ErrorType
+  deriving (Eq, Show, Exception)
+
+instance StrEncoding ProxyClientError where
+  strEncode = \case
+    ProxyProtocolError e -> "PROTOCOL " <> strEncode e
+    ProxyUnexpectedResponse s -> "UNEXPECTED " <> B.pack s
+    ProxyResponseError e -> "SYNTAX " <> strEncode e
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "PROTOCOL" -> ProxyProtocolError <$> _strP
+      "UNEXPECTED" -> ProxyUnexpectedResponse . B.unpack <$> (A.space *> A.takeByteString)
+      "SYNTAX" -> ProxyResponseError <$> _strP
+      _ -> fail "bad ProxyClientError"
+
+-- 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
+-- receives PRES :: EncResponse -> BrokerMsg -- proxy to client
+
+-- When client sends message via proxy, there may be one successful scenario and 9 error scenarios
+-- as shown below (WTF stands for unexpected response, ??? for response that failed to parse).
+--    client        proxy   relay   proxy        client
+-- 0) PFWD(SEND) -> RFWD -> RRES -> PRES(OK)  -> ok
+-- 1) PFWD(SEND) -> RFWD -> RRES -> PRES(ERR) -> PCEProtocolError - business logic error for client
+-- 2) PFWD(SEND) -> RFWD -> RRES -> PRES(WTF) -> PCEUnexpectedReponse - relay/client protocol logic error
+-- 3) PFWD(SEND) -> RFWD -> RRES -> PRES(???) -> PCEResponseError - relay/client syntax error
+-- 4) PFWD(SEND) -> RFWD -> ERR ->  ERR PROXY PROTOCOL -> ProxyProtocolError - proxy/relay business logic error
+-- 5) PFWD(SEND) -> RFWD -> WTF ->  ERR PROXY $ BROKER (UNEXPECTED s) -> ProxyProtocolError - proxy/relay protocol logic
+-- 6) PFWD(SEND) -> RFWD -> ??? ->  ERR PROXY $ BROKER (RESPONSE s) -> ProxyProtocolError - - proxy/relay syntax
+-- 7) PFWD(SEND) -> ERR  -> ProxyProtocolError - client/proxy business logic
+-- 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:
+-- - 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 ::
+  SMPClient ->
+  -- proxy session from PKEY
+  ProxiedRelay ->
+  -- message to deliver
+  Maybe SndPrivateAuthKey ->
+  SenderId ->
+  MsgFlags ->
+  MsgBody ->
+  ExceptT SMPClientError IO (Either ProxyClientError ())
+proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v serverKey) spKey sId flags msg = 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
+  -- encode
+  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender (SEND flags msg))
+  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
+  -- 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
+    Right r -> case r of
+      PRES (EncResponse er) -> do
+        -- server interaction errors are thrown directly
+        t' <- liftEitherWith PCECryptoError $ C.cbDecrypt cmdSecret (C.reverseNonce nonce) er
+        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 e -> throwE $ PCEUnexpectedResponse $ B.take 32 $ bshow e
+              Left e -> throwE $ PCEResponseError e
+          _ -> throwE $ PCETransportError TEBadBlock
+      ERR e -> pure . Left $ ProxyProtocolError e -- this will not happen, this error is returned via Left
+      _ -> pure . Left $ ProxyUnexpectedResponse $ take 32 $ show r
+    Left e -> case e of
+      PCEProtocolError e' -> pure . Left $ ProxyProtocolError e'
+      PCEUnexpectedResponse r -> pure . Left $ ProxyUnexpectedResponse $ B.unpack r
+      PCEResponseError e' -> pure . Left $ ProxyResponseError e'
+      _ -> throwE e
+
+-- this method is used in the proxy
+-- 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
+  -- prepare params
+  sessSecret <- case thAuth thParams of
+    Nothing -> throwError $ PCETransportError TENoServerAuth
+    Just THAuthClient {sessSecret} -> maybe (throwError $ PCETransportError TENoServerAuth) pure sessSecret
+  nonce <- liftIO . atomically $ C.randomCbNonce g
+  -- wrap
+  let fwdT = FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission}
+      eft = EncFwdTransmission $ C.cbEncryptNoPad sessSecret nonce (smpEncode fwdT)
+  -- send
+  sendProtocolCommand_ c (Just nonce) Nothing Nothing "" (Cmd SSender (RFWD eft)) >>= \case
+    RRES (EncFwdResponse efr) -> do
+      -- unwrap
+      r' <- liftEitherWith PCECryptoError $ C.cbDecryptNoPad sessSecret (C.reverseNonce nonce) efr
+      FwdResponse {fwdCorrId = _, fwdResponse} <- liftEitherWith (const $ PCEResponseError BLOCK) $ smpDecode r'
+      pure fwdResponse
+    r -> throwE . PCEUnexpectedResponse $ B.take 32 $ bshow r
+
 okSMPCommand :: PartyI p => Command p -> SMPClient -> C.APrivateAuthKey -> QueueId -> ExceptT SMPClientError IO ()
 okSMPCommand cmd c pKey qId =
  sendSMPCommand c (Just pKey) qId cmd >>= \case
@@ -729,16 +951,19 @@ sendBatch c@ProtocolClient {client_ = PClient {sndQ}} b = do
    TBTransmissions s n rs
      | n > 0 -> do
          atomically $ writeTBQueue sndQ s
-          mapConcurrently (getResponse c) rs
+          mapConcurrently (getResponse c Nothing) rs
      | otherwise -> pure []
    TBTransmission s r -> do
      atomically $ writeTBQueue sndQ s
-      (: []) <$> getResponse c r
+      (: []) <$> getResponse c Nothing r

 -- | Send Protocol command
 sendProtocolCommand :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> Maybe C.APrivateAuthKey -> EntityId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg
-sendProtocolCommand c@ProtocolClient {client_ = PClient {sndQ}, thParams = THandleParams {batch, blockSize}} pKey entId cmd =
-  ExceptT $ uncurry sendRecv =<< mkTransmission c (pKey, entId, cmd)
+sendProtocolCommand c = sendProtocolCommand_ c Nothing Nothing
+
+sendProtocolCommand_ :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> Maybe C.CbNonce -> Maybe Int -> Maybe C.APrivateAuthKey -> EntityId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg
+sendProtocolCommand_ c@ProtocolClient {client_ = PClient {sndQ}, thParams = THandleParams {batch, blockSize}} nonce_ tOut pKey entId cmd =
+  ExceptT $ uncurry sendRecv =<< mkTransmission_ c nonce_ (pKey, entId, cmd)
  where
    -- two separate "atomically" needed to avoid blocking
    sendRecv :: Either TransportError SentRawTransmission -> Request err msg -> IO (Either (ProtocolClientError err) msg)
@@ -748,15 +973,15 @@ sendProtocolCommand c@ProtocolClient {client_ = PClient {sndQ}, thParams = THand
        | B.length s > blockSize - 2 -> pure . Left $ PCETransportError TELargeMsg
        | otherwise -> do
            atomically $ writeTBQueue sndQ s
-            response <$> getResponse c r
+            response <$> getResponse c tOut r
        where
          s
            | batch = tEncodeBatch1 t
            | otherwise = tEncode t

-getResponse :: ProtocolClient v err msg -> Request err msg -> IO (Response err msg)
-getResponse ProtocolClient {client_ = PClient {tcpTimeout, timeoutErrorCount}} Request {entityId, pending, responseVar} = do
-  r <- tcpTimeout `timeout` atomically (takeTMVar responseVar)
+getResponse :: ProtocolClient v err msg -> Maybe Int -> Request err msg -> IO (Response err msg)
+getResponse ProtocolClient {client_ = PClient {tcpTimeout, timeoutErrorCount}} tOut Request {entityId, pending, responseVar} = do
+  r <- fromMaybe tcpTimeout tOut `timeout` atomically (takeTMVar responseVar)
  response <- atomically $ do
    writeTVar pending False
    -- Try to read response again in case it arrived after timeout expired
@@ -767,16 +992,17 @@ getResponse ProtocolClient {client_ = PClient {tcpTimeout, timeoutErrorCount}} R
      Nothing -> modifyTVar' timeoutErrorCount (+ 1) $> Left PCEResponseTimeout
  pure Response {entityId, response}

-mkTransmission :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> ClientCommand msg -> IO (PCTransmission err msg)
-mkTransmission ProtocolClient {thParams, client_ = PClient {clientCorrId, sentCommands}} (pKey_, entityId, command) = do
-  corrId <- atomically getNextCorrId
-  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (corrId, entityId, command)
-      auth = authTransmission (thAuth thParams) pKey_ corrId tForAuth
-  r <- atomically $ mkRequest corrId
+mkTransmission :: Protocol v err msg => ProtocolClient v err msg -> ClientCommand msg -> IO (PCTransmission err msg)
+mkTransmission c = mkTransmission_ c Nothing
+
+mkTransmission_ :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> Maybe C.CbNonce -> ClientCommand msg -> IO (PCTransmission err msg)
+mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentCommands}} nonce_ (pKey_, entityId, command) = do
+  nonce@(C.CbNonce corrId) <- maybe (atomically $ C.randomCbNonce clientCorrId) pure nonce_
+  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, entityId, command)
+      auth = authTransmission (thAuth thParams) pKey_ nonce tForAuth
+  r <- atomically $ mkRequest (CorrId corrId)
  pure ((,tToSend) <$> auth, r)
  where
-    getNextCorrId :: STM CorrId
-    getNextCorrId = CorrId <$> C.randomBytes 24 clientCorrId -- also used as nonce
    mkRequest :: CorrId -> STM (Request err msg)
    mkRequest corrId = do
      pending <- newTVar True
@@ -792,13 +1018,13 @@ mkTransmission ProtocolClient {thParams, client_ = PClient {clientCorrId, sentCo
      TM.insert corrId r sentCommands
      pure r

-authTransmission :: Maybe (THandleAuth 'TClient) -> Maybe C.APrivateAuthKey -> CorrId -> ByteString -> Either TransportError (Maybe TransmissionAuth)
-authTransmission thAuth pKey_ (CorrId corrId) t = traverse authenticate pKey_
+authTransmission :: Maybe (THandleAuth 'TClient) -> Maybe C.APrivateAuthKey -> C.CbNonce -> ByteString -> Either TransportError (Maybe TransmissionAuth)
+authTransmission thAuth pKey_ nonce t = traverse authenticate pKey_
  where
    authenticate :: C.APrivateAuthKey -> Either TransportError TransmissionAuth
    authenticate (C.APrivateAuthKey a pk) = case a of
      C.SX25519 -> case thAuth of
-        Just THAuthClient {serverPeerPubKey = k} -> Right $ TAAuthenticator $ C.cbAuthenticate k pk (C.cbNonce corrId) t
+        Just THAuthClient {serverPeerPubKey = k} -> Right $ TAAuthenticator $ C.cbAuthenticate k pk nonce t
        Nothing -> Left TENoServerAuth
      C.SEd25519 -> sign pk
      C.SEd448 -> sign pk
@@ -807,6 +1033,14 @@ authTransmission thAuth pKey_ (CorrId corrId) t = traverse authenticate pKey_

 $(J.deriveJSON (enumJSON $ dropPrefix "HM") ''HostMode)

+$(J.deriveJSON (enumJSON $ dropPrefix "SM") ''SocksMode)
+
 $(J.deriveJSON (enumJSON $ dropPrefix "TSM") ''TransportSessionMode)

+$(J.deriveJSON (enumJSON $ dropPrefix "SPM") ''SMPProxyMode)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "SPF") ''SMPProxyFallback)
+
 $(J.deriveJSON defaultJSON ''NetworkConfig)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "Proxy") ''ProxyClientError)
@@ -98,6 +98,7 @@ data SMPClientAgent = SMPClientAgent
    agentQ :: TBQueue SMPClientAgentEvent,
    randomDrg :: TVar ChaChaDRG,
    smpClients :: TMap SMPServer SMPClientVar,
+    smpSessions :: TMap SessionId SMPClient,
    srvSubs :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey),
    pendingSrvSubs :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey),
    reconnections :: TVar [Async ()],
@@ -135,6 +136,7 @@ newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg
  msgQ <- newTBQueue msgQSize
  agentQ <- newTBQueue agentQSize
  smpClients <- TM.empty
+  smpSessions <- TM.empty
  srvSubs <- TM.empty
  pendingSrvSubs <- TM.empty
  reconnections <- newTVar []
@@ -147,6 +149,7 @@ newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg
        agentQ,
        randomDrg,
        smpClients,
+        smpSessions,
        srvSubs,
        pendingSrvSubs,
        reconnections,
@@ -155,7 +158,7 @@ newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg
      }

 getSMPServerClient' :: SMPClientAgent -> SMPServer -> ExceptT SMPClientError IO SMPClient
-getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, msgQ, randomDrg, workerSeq} srv =
+getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, msgQ, randomDrg, workerSeq} srv =
  atomically getClientVar >>= either newSMPClient waitForSMPClient
  where
    getClientVar :: STM (Either SMPClientVar SMPClientVar)
@@ -178,7 +181,9 @@ getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, msgQ, randomDrg, wo
          tryE (connectClient v) >>= \r -> case r of
            Right smp -> do
              logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
-              atomically $ putTMVar (sessionVar v) r
+              atomically $ do
+                putTMVar (sessionVar v) r
+                TM.insert (sessionId $ thParams smp) smp smpSessions
              successAction smp
            Left e -> do
              if e == PCENetworkError || e == PCEResponseTimeout
@@ -200,13 +205,14 @@ getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, msgQ, randomDrg, wo
    connectClient v = ExceptT $ getProtocolClient randomDrg (1, srv, Nothing) (smpCfg agentCfg) (Just msgQ) (clientDisconnected v)

    clientDisconnected :: SMPClientVar -> SMPClient -> IO ()
-    clientDisconnected v _ = do
-      removeClientAndSubs v >>= (`forM_` serverDown)
+    clientDisconnected v smp = do
+      removeClientAndSubs v smp >>= (`forM_` serverDown)
      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv

-    removeClientAndSubs :: SMPClientVar -> IO (Maybe (Map SMPSub C.APrivateAuthKey))
-    removeClientAndSubs v = atomically $ do
+    removeClientAndSubs :: SMPClientVar -> SMPClient -> IO (Maybe (Map SMPSub C.APrivateAuthKey))
+    removeClientAndSubs v smp = atomically $ do
      removeSessVar v srv smpClients
+      TM.delete (sessionId $ thParams smp) smpSessions
      TM.lookupDelete srv (srvSubs ca) >>= mapM updateSubs
      where
        updateSubs sVar = do
@@ -271,6 +277,9 @@ getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, msgQ, randomDrg, wo
    notify :: SMPClientAgentEvent -> IO ()
    notify evt = atomically $ writeTBQueue (agentQ ca) evt

+lookupSMPServerClient :: SMPClientAgent -> SessionId -> STM (Maybe SMPClient)
+lookupSMPServerClient SMPClientAgent {smpSessions} sessId = TM.lookup sessId smpSessions
+
 closeSMPClientAgent :: SMPClientAgent -> IO ()
 closeSMPClientAgent c = do
  closeSMPServerClients c
@@ -141,6 +141,7 @@ module Simplex.Messaging.Crypto
    sbEncrypt_,
    cbNonce,
    randomCbNonce,
+    reverseNonce,

    -- * NaCl crypto_secretbox
    SbKey (unSbKey),
@@ -756,6 +757,8 @@ data Signature (a :: Algorithm) where
  SignatureEd25519 :: Ed25519.Signature -> Signature Ed25519
  SignatureEd448 :: Ed448.Signature -> Signature Ed448

+deriving instance Eq (Signature a)
+
 deriving instance Show (Signature a)

 data ASignature
@@ -1290,6 +1293,9 @@ randomCbNonce = fmap CryptoBoxNonce . randomBytes 24
 randomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
 randomBytes n gVar = stateTVar gVar $ randomBytesGenerate n

+reverseNonce :: CbNonce -> CbNonce
+reverseNonce (CryptoBoxNonce s) = CryptoBoxNonce (B.reverse s)
+
 instance Encoding CbNonce where
  smpEncode = unCbNonce
  smpP = CryptoBoxNonce <$> A.take 24
@@ -117,7 +117,7 @@ import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON, parseE, parseE')
-import Simplex.Messaging.Util ((<$?>), ($>>=))
+import Simplex.Messaging.Util (($>>=), (<$?>))
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
 import UnliftIO.STM
@@ -266,6 +266,7 @@ instance VersionRangeI E2EVersion (E2ERatchetParamsUri s a) where
  type VersionT E2EVersion (E2ERatchetParamsUri s a) = (E2ERatchetParams s a)
  versionRange (E2ERatchetParamsUri vr _ _ _) = vr
  toVersionT (E2ERatchetParamsUri _ k1 k2 kem_) v = E2ERatchetParams v k1 k2 kem_
+  toVersionRange (E2ERatchetParamsUri _ k1 k2 kem_) vr = E2ERatchetParamsUri vr k1 k2 kem_

 type RcvE2ERatchetParamsUri a = E2ERatchetParamsUri 'RKSProposed a

@@ -377,13 +378,15 @@ generateE2EParams g v useKEM_ = do
  where
    kemParams :: IO (Maybe (RKEMParams s, PrivRKEMParams s))
    kemParams = case useKEM_ of
-      Just useKem | v >= pqRatchetE2EEncryptVersion -> Just <$> do
-        ks@(k, _) <- sntrup761Keypair g
-        case useKem of
-          ProposeKEM -> pure (RKParamsProposed k, PrivateRKParamsProposed ks)
-          AcceptKEM k' -> do
-            (ct, shared) <- sntrup761Enc g k'
-            pure (RKParamsAccepted ct k, PrivateRKParamsAccepted ct shared ks)
+      Just useKem
+        | v >= pqRatchetE2EEncryptVersion ->
+            Just <$> do
+              ks@(k, _) <- sntrup761Keypair g
+              case useKem of
+                ProposeKEM -> pure (RKParamsProposed k, PrivateRKParamsProposed ks)
+                AcceptKEM k' -> do
+                  (ct, shared) <- sntrup761Enc g k'
+                  pure (RKParamsAccepted ct k, PrivateRKParamsAccepted ct shared ks)
      _ -> pure Nothing

 -- used by party initiating connection, Bob in double-ratchet spec
@@ -456,7 +459,7 @@ pqX3dh (sk1, rk1) dh1 dh2 dh3 kemAccepted =
    pq = maybe "" (\RatchetKEMAccepted {rcPQRss = KEMSharedKey ss} -> BA.convert ss) kemAccepted
    (hk, nhk, sk) =
      let salt = B.replicate 64 '\0'
-        in hkdf3 salt dhs "SimpleXX3DH"
+       in hkdf3 salt dhs "SimpleXX3DH"

 type RatchetX448 = Ratchet 'X448

@@ -698,8 +701,8 @@ data EncMessageHeader = EncMessageHeader

 -- this encoding depends on version in EncMessageHeader because it is "current" ratchet version
 instance Encoding EncMessageHeader where
-  smpEncode EncMessageHeader {ehVersion, ehIV, ehAuthTag, ehBody}
-    = smpEncode (ehVersion, ehIV, ehAuthTag) <> encodeLarge ehVersion ehBody
+  smpEncode EncMessageHeader {ehVersion, ehIV, ehAuthTag, ehBody} =
+    smpEncode (ehVersion, ehIV, ehAuthTag) <> encodeLarge ehVersion ehBody
  smpP = do
    (ehVersion, ehIV, ehAuthTag) <- smpP
    ehBody <- largeP
@@ -708,8 +711,6 @@ instance Encoding EncMessageHeader where
 -- the encoder always uses 2-byte lengths for the new version, even for short headers without PQ keys.
 encodeLarge :: VersionE2E -> ByteString -> ByteString
 encodeLarge v s
-  -- the condition for length is not necessary, it's here as a fallback.
-  -- | v >= pqRatchetE2EEncryptVersion || B.length s > 255 = smpEncode $ Large s
  | v >= pqRatchetE2EEncryptVersion = smpEncode $ Large s
  | otherwise = smpEncode s

@@ -729,8 +730,8 @@ data EncRatchetMessage = EncRatchetMessage
  }

 encodeEncRatchetMessage :: VersionE2E -> EncRatchetMessage -> ByteString
-encodeEncRatchetMessage v EncRatchetMessage {emHeader, emBody, emAuthTag}
-  = encodeLarge v emHeader <> smpEncode (emAuthTag, Tail emBody)
+encodeEncRatchetMessage v EncRatchetMessage {emHeader, emBody, emAuthTag} =
+  encodeLarge v emHeader <> smpEncode (emAuthTag, Tail emBody)

 encRatchetMessageP :: Parser EncRatchetMessage
 encRatchetMessageP = do
@@ -75,6 +75,8 @@ instance StrEncoding Str where
  strEncode = unStr
  strP = Str <$> A.takeTill (== ' ') <* optional A.space

+-- inherited from ByteString, the parser only allows non-empty strings
+-- only Char8 elements may round-trip as B.pack truncates unicode
 instance StrEncoding String where
  strEncode = strEncode . B.pack
  strP = B.unpack <$> strP
@@ -11,6 +11,7 @@ module Simplex.Messaging.Notifications.Transport where

 import Control.Monad (forM)
 import Control.Monad.Except
+import Control.Monad.Trans.Except
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -116,9 +117,10 @@ ntfServerHandshake serverSignKey c (k, pk) kh ntfVRange = do
    NtfClientHandshake {ntfVersion = v, keyHash}
      | keyHash /= kh ->
          throwError $ TEHandshake IDENTITY
-      | v `isCompatible` ntfVersionRange ->
-          pure $ ntfThHandleServer th v pk
-      | otherwise -> throwError $ TEHandshake VERSION
+      | otherwise ->
+          case compatibleVRange' ntfVersionRange v of
+            Just (Compatible vr) -> pure $ ntfThHandleServer th v vr pk
+            Nothing -> throwE TEVersion

 -- | Notifcations server client transport handshake.
 ntfClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRangeNTF -> ExceptT TransportError IO (THandleNTF c 'TClient)
@@ -127,34 +129,45 @@ ntfClientHandshake c keyHash ntfVRange = do
  NtfServerHandshake {sessionId = sessId, ntfVersionRange, authPubKey = sk'} <- getHandshake th
  if sessionId /= sessId
    then throwError TEBadSession
-    else case ntfVersionRange `compatibleVersion` ntfVRange of
-      Just (Compatible v) -> do
+    else case ntfVersionRange `compatibleVRange` ntfVRange of
+      Just (Compatible vr) -> do
        ck_ <- forM sk' $ \signedKey -> liftEitherWith (const $ TEHandshake BAD_AUTH) $ do
          serverKey <- getServerVerifyKey c
          pubKey <- C.verifyX509 serverKey signedKey
          (,(getServerCerts c, signedKey)) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey)
+        let v = maxVersion vr
        sendHandshake th $ NtfClientHandshake {ntfVersion = v, keyHash}
-        pure $ ntfThHandleClient th v ck_
-      Nothing -> throwError $ TEHandshake VERSION
+        pure $ ntfThHandleClient th v vr ck_
+      Nothing -> throwE TEVersion

-ntfThHandleServer :: forall c. THandleNTF c 'TServer -> VersionNTF -> C.PrivateKeyX25519 -> THandleNTF c 'TServer
-ntfThHandleServer th v pk =
+ntfThHandleServer :: forall c. THandleNTF c 'TServer -> VersionNTF -> VersionRangeNTF -> C.PrivateKeyX25519 -> THandleNTF c 'TServer
+ntfThHandleServer th v vr pk =
  let thAuth = THAuthServer {serverPrivKey = pk, sessSecret' = Nothing}
-   in ntfThHandle_ th v (Just thAuth)
+   in ntfThHandle_ th v vr (Just thAuth)

-ntfThHandleClient :: forall c. THandleNTF c 'TClient -> VersionNTF -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> THandleNTF c 'TClient
-ntfThHandleClient th v ck_ =
+ntfThHandleClient :: forall c. THandleNTF c 'TClient -> VersionNTF -> VersionRangeNTF -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> THandleNTF c 'TClient
+ntfThHandleClient th v vr ck_ =
  let thAuth = (\(k, ck) -> THAuthClient {serverPeerPubKey = k, serverCertKey = ck, sessSecret = Nothing}) <$> ck_
-   in ntfThHandle_ th v thAuth
+   in ntfThHandle_ th v vr thAuth

-ntfThHandle_ :: forall c p. THandleNTF c p -> VersionNTF -> Maybe (THandleAuth p) -> THandleNTF c p
-ntfThHandle_ th@THandle {params} v thAuth =
+ntfThHandle_ :: forall c p. THandleNTF c p -> VersionNTF -> VersionRangeNTF -> Maybe (THandleAuth p) -> THandleNTF c p
+ntfThHandle_ th@THandle {params} v vr thAuth =
  -- TODO drop SMP v6: make thAuth non-optional
  let v3 = v >= authBatchCmdsNTFVersion
-      params' = params {thVersion = v, thAuth, implySessId = v3, batch = v3}
+      params' = params {thVersion = v, thServerVRange = vr, thAuth, implySessId = v3, batch = v3}
   in (th :: THandleNTF c p) {params = params'}

 ntfTHandle :: Transport c => c -> THandleNTF c p
 ntfTHandle c = THandle {connection = c, params}
  where
-    params = THandleParams {sessionId = tlsUnique c, blockSize = ntfBlockSize, thVersion = VersionNTF 0, thAuth = Nothing, implySessId = False, batch = False}
+    v = VersionNTF 0
+    params =
+      THandleParams
+        { sessionId = tlsUnique c,
+          blockSize = ntfBlockSize,
+          thVersion = v,
+          thServerVRange = versionToRange v,
+          thAuth = Nothing,
+          implySessId = False,
+          batch = False
+        }
@@ -43,6 +43,7 @@ module Simplex.Messaging.Protocol
  ( -- * SMP protocol parameters
    supportedSMPClientVRange,
    maxMessageLength,
+    paddedProxiedMsgLength,
    e2eEncConfirmationLength,
    e2eEncMessageLength,

@@ -56,6 +57,7 @@ module Simplex.Messaging.Protocol
    SubscriptionMode (..),
    Party (..),
    Cmd (..),
+    DirectParty,
    BrokerMsg (..),
    SParty (..),
    PartyI (..),
@@ -63,6 +65,8 @@ module Simplex.Messaging.Protocol
    ProtocolErrorType (..),
    ErrorType (..),
    CommandError (..),
+    ProxyError (..),
+    BrokerErrorType (..),
    Transmission,
    TransmissionAuth (..),
    SignedTransmission,
@@ -121,6 +125,12 @@ module Simplex.Messaging.Protocol
    EncNMsgMeta,
    SMPMsgMeta (..),
    NMsgMeta (..),
+    EncFwdResponse (..),
+    EncFwdTransmission (..),
+    EncResponse (..),
+    EncTransmission (..),
+    FwdResponse (..),
+    FwdTransmission (..),
    MsgFlags (..),
    initialSMPClientVersion,
    userProtocol,
@@ -167,6 +177,7 @@ module Simplex.Messaging.Protocol
 where

 import Control.Applicative (optional, (<|>))
+import Control.Exception (Exception)
 import Control.Monad
 import Control.Monad.Except
 import Data.Aeson (FromJSON (..), ToJSON (..))
@@ -185,10 +196,15 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (isJust, isNothing)
 import Data.String
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock.System (SystemTime (..))
 import Data.Type.Equality
 import Data.Word (Word16)
+import qualified Data.X509 as X
 import GHC.TypeLits (ErrorMessage (..), TypeError, type (+))
+import qualified GHC.TypeLits as TE
+import qualified GHC.TypeLits as Type
 import Network.Socket (ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
@@ -197,7 +213,7 @@ import Simplex.Messaging.Parsers
 import Simplex.Messaging.ServiceScheme
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts (..))
-import Simplex.Messaging.Util (bshow, eitherToMaybe, (<$?>))
+import Simplex.Messaging.Util (bshow, eitherToMaybe, safeDecodeUtf8, (<$?>))
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal

@@ -228,9 +244,16 @@ currentSMPClientVersion = VersionSMPC 2
 supportedSMPClientVRange :: VersionRangeSMPC
 supportedSMPClientVRange = mkVersionRange initialSMPClientVersion currentSMPClientVersion

-maxMessageLength :: Int
-maxMessageLength = 16088
+-- TODO v6.0 remove dependency on version
+maxMessageLength :: VersionSMP -> Int
+maxMessageLength v
+  | v >= sendingProxySMPVersion = 16064 -- max 16067
+  | otherwise = 16088 -- 16064 - always use this size to determine allowed ranges

+paddedProxiedMsgLength :: Int
+paddedProxiedMsgLength = 16242 -- 16241 .. 16243
+
+-- TODO v6.0 change to 16064
 type MaxMessageLen = 16088

 -- 16 extra bytes: 8 for timestamp and 8 for flags (7 flags and the space, only 1 flag is currently used)
@@ -244,7 +267,7 @@ e2eEncMessageLength :: Int
 e2eEncMessageLength = 16016 -- 16004 .. 16021

 -- | SMP protocol clients
-data Party = Recipient | Sender | Notifier
+data Party = Recipient | Sender | Notifier | ProxiedClient
  deriving (Show)

 -- | Singleton types for SMP protocol clients
@@ -252,11 +275,13 @@ data SParty :: Party -> Type where
  SRecipient :: SParty Recipient
  SSender :: SParty Sender
  SNotifier :: SParty Notifier
+  SProxiedClient :: SParty ProxiedClient

 instance TestEquality SParty where
  testEquality SRecipient SRecipient = Just Refl
  testEquality SSender SSender = Just Refl
  testEquality SNotifier SNotifier = Just Refl
+  testEquality SProxiedClient SProxiedClient = Just Refl
  testEquality _ _ = Nothing

 deriving instance Show (SParty p)
@@ -269,6 +294,15 @@ instance PartyI Sender where sParty = SSender

 instance PartyI Notifier where sParty = SNotifier

+instance PartyI ProxiedClient where sParty = SProxiedClient
+
+type family DirectParty (p :: Party) :: Constraint where
+  DirectParty Recipient = ()
+  DirectParty Sender = ()
+  DirectParty Notifier = ()
+  DirectParty p =
+    (Int ~ Bool, TypeError (Type.Text "Party " :<>: ShowType p :<>: Type.Text " is not direct"))
+
 -- | Type for client command of any participant.
 data Cmd = forall p. PartyI p => Cmd (SParty p) (Command p)

@@ -359,6 +393,17 @@ data Command (p :: Party) where
  PING :: Command Sender
  -- SMP notification subscriber commands
  NSUB :: Command Notifier
+  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)
+  -- - corrId: also used as a nonce to encrypt transmission to relay, corrId + 1 - from relay
+  -- - key (1st param in the command) is used to agree DH secret for this particular transmission and its response
+  -- Encrypted transmission should include session ID (tlsunique) from proxy-relay connection.
+  PFWD :: VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> Command ProxiedClient -- use CorrId as CbNonce, client to proxy
+  -- Transmission forwarded to relay:
+  -- - entity ID: empty
+  -- - corrId: unique correlation ID between proxy and relay, also used as a nonce to encrypt forwarded transmission
+  RFWD :: EncFwdTransmission -> Command Sender -- use CorrId as CbNonce, proxy to relay

 deriving instance Show (Command p)

@@ -384,6 +429,26 @@ instance Encoding SubscriptionMode where
      'C' -> pure SMOnlyCreate
      _ -> fail "bad SubscriptionMode"

+newtype EncTransmission = EncTransmission ByteString
+  deriving (Show)
+
+data FwdTransmission = FwdTransmission
+  { fwdCorrId :: CorrId,
+    fwdVersion :: VersionSMP,
+    fwdKey :: C.PublicKeyX25519,
+    fwdTransmission :: EncTransmission
+  }
+
+instance Encoding FwdTransmission where
+  smpEncode FwdTransmission {fwdCorrId = CorrId corrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t} =
+    smpEncode (corrId, fwdVersion, fwdKey, Tail t)
+  smpP = do
+    (corrId, fwdVersion, fwdKey, Tail t) <- smpP
+    pure FwdTransmission {fwdCorrId = CorrId corrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t}
+
+newtype EncFwdTransmission = EncFwdTransmission ByteString
+  deriving (Show)
+
 data BrokerMsg where
  -- SMP broker messages (responses, client messages, notifications)
  IDS :: QueueIdsKeys -> BrokerMsg
@@ -393,6 +458,10 @@ data BrokerMsg where
  MSG :: RcvMessage -> BrokerMsg
  NID :: NotifierId -> RcvNtfPublicDhKey -> BrokerMsg
  NMSG :: C.CbNonce -> EncNMsgMeta -> BrokerMsg
+  -- Should include certificate chain
+  PKEY :: SessionId -> VersionRangeSMP -> (X.CertificateChain, X.SignedExact X.PubKey) -> BrokerMsg -- TLS-signed server key for proxy shared secret and initial sender key
+  RRES :: EncFwdResponse -> BrokerMsg -- relay to proxy
+  PRES :: EncResponse -> BrokerMsg -- proxy to client
  END :: BrokerMsg
  OK :: BrokerMsg
  ERR :: ErrorType -> BrokerMsg
@@ -405,6 +474,24 @@ data RcvMessage = RcvMessage
  }
  deriving (Eq, Show)

+newtype EncFwdResponse = EncFwdResponse ByteString
+  deriving (Eq, Show)
+
+data FwdResponse = FwdResponse
+  { fwdCorrId :: CorrId,
+    fwdResponse :: EncResponse
+  }
+
+instance Encoding FwdResponse where
+  smpEncode FwdResponse {fwdCorrId = CorrId corrId, fwdResponse = EncResponse t} =
+    smpEncode (corrId, Tail t)
+  smpP = do
+    (corrId, Tail t) <- smpP
+    pure FwdResponse {fwdCorrId = CorrId corrId, fwdResponse = EncResponse t}
+
+newtype EncResponse = EncResponse ByteString
+  deriving (Eq, Show)
+
 -- | received message without server/recipient encryption
 data Message
  = Message
@@ -567,6 +654,9 @@ data CommandTag (p :: Party) where
  DEL_ :: CommandTag Recipient
  SEND_ :: CommandTag Sender
  PING_ :: CommandTag Sender
+  PRXY_ :: CommandTag ProxiedClient
+  PFWD_ :: CommandTag ProxiedClient
+  RFWD_ :: CommandTag Sender
  NSUB_ :: CommandTag Notifier

 data CmdTag = forall p. PartyI p => CT (SParty p) (CommandTag p)
@@ -580,6 +670,9 @@ data BrokerMsgTag
  | MSG_
  | NID_
  | NMSG_
+  | PKEY_
+  | RRES_
+  | PRES_
  | END_
  | OK_
  | ERR_
@@ -607,6 +700,9 @@ instance PartyI p => Encoding (CommandTag p) where
    DEL_ -> "DEL"
    SEND_ -> "SEND"
    PING_ -> "PING"
+    PRXY_ -> "PRXY"
+    PFWD_ -> "PFWD"
+    RFWD_ -> "RFWD"
    NSUB_ -> "NSUB"
  smpP = messageTagP

@@ -623,6 +719,9 @@ instance ProtocolMsgTag CmdTag where
    "DEL" -> Just $ CT SRecipient DEL_
    "SEND" -> Just $ CT SSender SEND_
    "PING" -> Just $ CT SSender PING_
+    "PRXY" -> Just $ CT SProxiedClient PRXY_
+    "PFWD" -> Just $ CT SProxiedClient PFWD_
+    "RFWD" -> Just $ CT SSender RFWD_
    "NSUB" -> Just $ CT SNotifier NSUB_
    _ -> Nothing

@@ -639,6 +738,9 @@ instance Encoding BrokerMsgTag where
    MSG_ -> "MSG"
    NID_ -> "NID"
    NMSG_ -> "NMSG"
+    PKEY_ -> "PKEY"
+    RRES_ -> "RRES"
+    PRES_ -> "PRES"
    END_ -> "END"
    OK_ -> "OK"
    ERR_ -> "ERR"
@@ -651,6 +753,9 @@ instance ProtocolMsgTag BrokerMsgTag where
    "MSG" -> Just MSG_
    "NID" -> Just NID_
    "NMSG" -> Just NMSG_
+    "PKEY" -> Just PKEY_
+    "RRES" -> Just RRES_
+    "PRES" -> Just PRES_
    "END" -> Just END_
    "OK" -> Just OK_
    "ERR" -> Just ERR_
@@ -829,7 +934,7 @@ type family UserProtocol (p :: ProtocolType) :: Constraint where
  UserProtocol PSMP = ()
  UserProtocol PXFTP = ()
  UserProtocol a =
-    (Int ~ Bool, TypeError (Text "Servers for protocol " :<>: ShowType a :<>: Text " cannot be configured by the users"))
+    (Int ~ Bool, TypeError (TE.Text "Servers for protocol " :<>: ShowType a :<>: TE.Text " cannot be configured by the users"))

 userProtocol :: SProtocolType p -> Maybe (Dict (UserProtocol p))
 userProtocol = \case
@@ -1038,14 +1143,20 @@ data ErrorType
    SESSION
  | -- | SMP command is unknown or has invalid syntax
    CMD {cmdErr :: CommandError}
+  | -- | error from proxied relay
+    PROXY {proxyErr :: ProxyError}
  | -- | command authorization error - bad signature or non-existing SMP queue
    AUTH
+  | -- | encryption/decryption error in proxy protocol
+    CRYPTO
  | -- | SMP queue capacity is exceeded on the server
    QUOTA
  | -- | ACK command is sent without message to be acknowledged
    NO_MSG
  | -- | sent message is too large (> maxMessageLength = 16088 bytes)
    LARGE_MSG
+  | -- | relay public key is expired
+    EXPIRED
  | -- | internal server error
    INTERNAL
  | -- | used internally, never returned by the server (to be removed)
@@ -1055,8 +1166,12 @@ data ErrorType
 instance StrEncoding ErrorType where
  strEncode = \case
    CMD e -> "CMD " <> bshow e
+    PROXY e -> "PROXY " <> strEncode e
    e -> bshow e
-  strP = "CMD " *> (CMD <$> parseRead1) <|> parseRead1
+  strP =
+    "CMD " *> (CMD <$> parseRead1)
+      <|> "PROXY " *> (PROXY <$> strP)
+      <|> parseRead1

 -- | SMP command error type.
 data CommandError
@@ -1074,6 +1189,34 @@ data CommandError
    NO_ENTITY
  deriving (Eq, Read, Show)

+data ProxyError
+  = -- | Correctly parsed SMP server ERR response.
+    -- This error is forwarded to the agent client as AgentErrorType `ERR PROXY PROTOCOL err`.
+    PROTOCOL {protocolErr :: ErrorType}
+  | -- | destination server error
+    BROKER {brokerErr :: BrokerErrorType}
+  | -- | basic auth provided to proxy is invalid
+    BASIC_AUTH
+  | -- no destination server error
+    NO_SESSION
+  deriving (Eq, Read, Show)
+
+-- | SMP server errors.
+data BrokerErrorType
+  = -- | invalid server response (failed to parse)
+    RESPONSE {respErr :: String}
+  | -- | unexpected response
+    UNEXPECTED {respErr :: String}
+  | -- | network error
+    NETWORK
+  | -- | no compatible server host (e.g. onion when public is required, or vice versa)
+    HOST
+  | -- | handshake or other transport error
+    TRANSPORT {transportErr :: TransportError}
+  | -- | command response timeout
+    TIMEOUT
+  deriving (Eq, Read, Show, Exception)
+
 -- | SMP transmission parser.
 transmissionP :: THandleParams v p -> Parser RawTransmission
 transmissionP THandleParams {sessionId, implySessId} = do
@@ -1135,6 +1278,9 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
    SEND flags msg -> e (SEND_, ' ', flags, ' ', Tail msg)
    PING -> e PING_
    NSUB -> e NSUB_
+    PRXY host auth_ -> e (PRXY_, ' ', host, auth_)
+    PFWD fwdV pubKey (EncTransmission s) -> e (PFWD_, ' ', fwdV, pubKey, Tail s)
+    RFWD (EncFwdTransmission s) -> e (RFWD_, ' ', Tail s)
    where
      e :: Encoding a => a -> ByteString
      e = smpEncode
@@ -1144,24 +1290,33 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
  fromProtocolError = fromProtocolError @SMPVersion @ErrorType @BrokerMsg
  {-# INLINE fromProtocolError #-}

-  checkCredentials (auth, _, queueId, _) cmd = case cmd of
+  checkCredentials (auth, _, entId, _) cmd = case cmd of
    -- NEW must have signature but NOT queue ID
    NEW {}
      | isNothing auth -> Left $ CMD NO_AUTH
-      | not (B.null queueId) -> Left $ CMD HAS_AUTH
+      | not (B.null entId) -> Left $ CMD HAS_AUTH
      | otherwise -> Right cmd
    -- SEND must have queue ID, signature is not always required
    SEND {}
-      | B.null queueId -> Left $ CMD NO_ENTITY
+      | B.null entId -> Left $ CMD NO_ENTITY
      | otherwise -> Right cmd
-    -- PING must not have queue ID or signature
-    PING
-      | isNothing auth && B.null queueId -> Right cmd
+    PING -> noAuthCmd
+    PRXY {} -> noAuthCmd
+    PFWD {}
+      | B.null entId -> Left $ CMD NO_ENTITY
+      | isNothing auth -> Right cmd
      | otherwise -> Left $ CMD HAS_AUTH
+    RFWD _ -> noAuthCmd
    -- other client commands must have both signature and queue ID
    _
-      | isNothing auth || B.null queueId -> Left $ CMD NO_AUTH
+      | isNothing auth || B.null entId -> Left $ CMD NO_AUTH
      | otherwise -> Right cmd
+    where
+      -- command must not have entity ID (queue or session ID) or signature
+      noAuthCmd :: Either ErrorType (Command p)
+      noAuthCmd
+        | isNothing auth && B.null entId = Right cmd
+        | otherwise = Left $ CMD HAS_AUTH

 instance ProtocolEncoding SMPVersion ErrorType Cmd where
  type Tag Cmd = CmdTag
@@ -1189,6 +1344,11 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
      Cmd SSender <$> case tag of
        SEND_ -> SEND <$> _smpP <*> (unTail <$> _smpP)
        PING_ -> pure PING
+        RFWD_ -> RFWD <$> (EncFwdTransmission . unTail <$> _smpP)
+    CT SProxiedClient tag ->
+      Cmd SProxiedClient <$> case tag of
+        PFWD_ -> PFWD <$> _smpP <*> smpP <*> (EncTransmission . unTail <$> smpP)
+        PRXY_ -> PRXY <$> _smpP <*> smpP
    CT SNotifier NSUB_ -> pure $ Cmd SNotifier NSUB

  fromProtocolError = fromProtocolError @SMPVersion @ErrorType @BrokerMsg
@@ -1204,6 +1364,9 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
      e (MSG_, ' ', msgId, Tail body)
    NID nId srvNtfDh -> e (NID_, ' ', nId, srvNtfDh)
    NMSG nmsgNonce encNMsgMeta -> e (NMSG_, ' ', nmsgNonce, encNMsgMeta)
+    PKEY sid vr (cert, key) -> e (PKEY_, ' ', sid, vr, C.encodeCertChain cert, C.SignedObject key)
+    RRES (EncFwdResponse encBlock) -> e (RRES_, ' ', Tail encBlock)
+    PRES (EncResponse encBlock) -> e (PRES_, ' ', Tail encBlock)
    END -> e END_
    OK -> e OK_
    ERR err -> e (ERR_, ' ', err)
@@ -1221,6 +1384,9 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
    IDS_ -> IDS <$> (QIK <$> _smpP <*> smpP <*> smpP)
    NID_ -> NID <$> _smpP <*> smpP
    NMSG_ -> NMSG <$> _smpP <*> smpP
+    PKEY_ -> PKEY <$> _smpP <*> smpP <*> ((,) <$> C.certChainP <*> (C.getSignedExact <$> smpP))
+    RRES_ -> RRES <$> (EncFwdResponse . unTail <$> _smpP)
+    PRES_ -> PRES <$> (EncResponse . unTail <$> _smpP)
    END_ -> pure END
    OK_ -> pure OK
    ERR_ -> ERR <$> _smpP
@@ -1233,19 +1399,24 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
    PEBlock -> BLOCK
  {-# INLINE fromProtocolError #-}

-  checkCredentials (_, _, queueId, _) cmd = case cmd of
+  checkCredentials (_, _, entId, _) cmd = case cmd of
    -- IDS response should not have queue ID
    IDS _ -> Right cmd
    -- ERR response does not always have queue ID
    ERR _ -> Right cmd
    -- PONG response must not have queue ID
-    PONG
-      | B.null queueId -> Right cmd
-      | otherwise -> Left $ CMD HAS_AUTH
+    PONG -> noEntityMsg
+    PKEY {} -> noEntityMsg
+    RRES _ -> noEntityMsg
    -- other broker responses must have queue ID
    _
-      | B.null queueId -> Left $ CMD NO_ENTITY
+      | B.null entId -> Left $ CMD NO_ENTITY
      | otherwise -> Right cmd
+    where
+      noEntityMsg :: Either ErrorType BrokerMsg
+      noEntityMsg
+        | B.null entId = Right cmd
+        | otherwise = Left $ CMD HAS_AUTH

 -- | Parse SMP protocol commands and broker messages
 parseProtocol :: forall v err msg. ProtocolEncoding v err msg => Version v -> ByteString -> Either err msg
@@ -1268,8 +1439,11 @@ instance Encoding ErrorType where
    BLOCK -> "BLOCK"
    SESSION -> "SESSION"
    CMD err -> "CMD " <> smpEncode err
+    PROXY err -> "PROXY " <> smpEncode err
    AUTH -> "AUTH"
+    CRYPTO -> "CRYPTO"
    QUOTA -> "QUOTA"
+    EXPIRED -> "EXPIRED"
    NO_MSG -> "NO_MSG"
    LARGE_MSG -> "LARGE_MSG"
    INTERNAL -> "INTERNAL"
@@ -1280,13 +1454,16 @@ instance Encoding ErrorType where
      "BLOCK" -> pure BLOCK
      "SESSION" -> pure SESSION
      "CMD" -> CMD <$> _smpP
+      "PROXY" -> PROXY <$> _smpP
      "AUTH" -> pure AUTH
+      "CRYPTO" -> pure CRYPTO
      "QUOTA" -> pure QUOTA
+      "EXPIRED" -> pure EXPIRED
      "NO_MSG" -> pure NO_MSG
      "LARGE_MSG" -> pure LARGE_MSG
      "INTERNAL" -> pure INTERNAL
      "DUPLICATE_" -> pure DUPLICATE_
-      _ -> fail "bad error type"
+      _ -> fail "bad ErrorType"

 instance Encoding CommandError where
  smpEncode e = case e of
@@ -1304,8 +1481,74 @@ instance Encoding CommandError where
      "NO_AUTH" -> pure NO_AUTH
      "HAS_AUTH" -> pure HAS_AUTH
      "NO_ENTITY" -> pure NO_ENTITY
-      "NO_QUEUE" -> pure NO_ENTITY
-      _ -> fail "bad command error type"
+      "NO_QUEUE" -> pure NO_ENTITY -- for backward compatibility
+      _ -> fail "bad CommandError"
+
+instance Encoding ProxyError where
+  smpEncode = \case
+    PROTOCOL e -> "PROTOCOL " <> smpEncode e
+    BROKER e -> "BROKER " <> smpEncode e
+    BASIC_AUTH -> "BASIC_AUTH"
+    NO_SESSION -> "NO_SESSION"
+  smpP =
+    A.takeTill (== ' ') >>= \case
+      "PROTOCOL" -> PROTOCOL <$> _smpP
+      "BROKER" -> BROKER <$> _smpP
+      "BASIC_AUTH" -> pure BASIC_AUTH
+      "NO_SESSION" -> pure NO_SESSION
+      _ -> fail "bad ProxyError"
+
+instance StrEncoding ProxyError where
+  strEncode = \case
+    PROTOCOL e -> "PROTOCOL " <> strEncode e
+    BROKER e -> "BROKER " <> strEncode e
+    BASIC_AUTH -> "BASIC_AUTH"
+    NO_SESSION -> "NO_SESSION"
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "PROTOCOL" -> PROTOCOL <$> _strP
+      "BROKER" -> BROKER <$> _strP
+      "BASIC_AUTH" -> pure BASIC_AUTH
+      "NO_SESSION" -> pure NO_SESSION
+      _ -> fail "bad ProxyError"
+
+instance Encoding BrokerErrorType where
+  smpEncode = \case
+    RESPONSE e -> "RESPONSE " <> smpEncode e
+    UNEXPECTED e -> "UNEXPECTED " <> smpEncode e
+    TRANSPORT e -> "TRANSPORT " <> smpEncode e
+    NETWORK -> "NETWORK"
+    TIMEOUT -> "TIMEOUT"
+    HOST -> "HOST"
+  smpP =
+    A.takeTill (== ' ') >>= \case
+      "RESPONSE" -> RESPONSE <$> _smpP
+      "UNEXPECTED" -> UNEXPECTED <$> _smpP
+      "TRANSPORT" -> TRANSPORT <$> _smpP
+      "NETWORK" -> pure NETWORK
+      "TIMEOUT" -> pure TIMEOUT
+      "HOST" -> pure HOST
+      _ -> fail "bad BrokerErrorType"
+
+instance StrEncoding BrokerErrorType where
+  strEncode = \case
+    RESPONSE e -> "RESPONSE " <> encodeUtf8 (T.pack e)
+    UNEXPECTED e -> "UNEXPECTED " <> encodeUtf8 (T.pack e)
+    TRANSPORT e -> "TRANSPORT " <> smpEncode e
+    NETWORK -> "NETWORK"
+    TIMEOUT -> "TIMEOUT"
+    HOST -> "HOST"
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "RESPONSE" -> RESPONSE <$> _textP
+      "UNEXPECTED" -> UNEXPECTED <$> _textP
+      "TRANSPORT" -> TRANSPORT <$> _smpP
+      "NETWORK" -> pure NETWORK
+      "TIMEOUT" -> pure TIMEOUT
+      "HOST" -> pure HOST
+      _ -> fail "bad BrokerErrorType"
+    where
+      _textP = A.space *> (T.unpack . safeDecodeUtf8 <$> A.takeByteString)

 -- | Send signed SMP transmission to TCP transport.
 tPut :: Transport c => THandle v c p -> NonEmpty (Either TransportError SentRawTransmission) -> IO [Either TransportError ()]
@@ -1444,4 +1687,7 @@ $(J.deriveJSON defaultJSON ''MsgFlags)

 $(J.deriveJSON (sumTypeJSON id) ''CommandError)

-$(J.deriveJSON (sumTypeJSON id) ''ErrorType)
+$(J.deriveJSON (sumTypeJSON id) ''BrokerErrorType)
+
+-- run deriveJSON in one TH splice to allow mutual instance
+$(concat <$> mapM @[] (J.deriveJSON (sumTypeJSON id)) [''ProxyError, ''ErrorType])
@@ -13,7 +13,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}

 -- |
 -- Module      : Simplex.Messaging.Server
@@ -43,6 +42,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
+import Control.Monad.Trans.Except
 import Crypto.Random
 import Data.Bifunctor (first)
 import Data.ByteString.Base64 (encode)
@@ -54,7 +54,7 @@ import Data.Functor (($>))
 import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
 import Data.List (intercalate, mapAccumR)
-import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Data.Maybe (isNothing)
@@ -68,8 +68,10 @@ 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 (..), forwardSMPMessage, smpProxyError)
+import Simplex.Messaging.Client.Agent (SMPClientAgent (..), SMPClientAgentEvent (..), getSMPServerClient', lookupSMPServerClient)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Encoding (Encoding (smpEncode))
+import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Control
@@ -87,10 +89,12 @@ import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.Server
 import Simplex.Messaging.Util
+import Simplex.Messaging.Version
 import System.Exit (exitFailure)
 import System.IO (hPrint, hPutStrLn, hSetNewlineMode, universalNewlineMode)
 import System.Mem.Weak (deRefWeak)
 import UnliftIO (timeout)
+import UnliftIO.Async (mapConcurrently)
 import UnliftIO.Concurrent
 import UnliftIO.Directory (doesFileExist, renameFile)
 import UnliftIO.Exception
@@ -123,11 +127,13 @@ type M a = ReaderT Env IO a
 smpServer :: TMVar Bool -> ServerConfig -> M ()
 smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
  s <- asks server
+  pa <- asks proxyAgent
  expired <- restoreServerMessages
  restoreServerStats expired
  raceAny_
    ( serverThread s "server subscribedQ" subscribedQ subscribers subscriptions cancelSub
        : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubscriptions (\_ -> pure ())
+        : receiveFromProxyAgent pa
        : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
    )
    `finally` withLock' (savingLock s) "final" (saveServer False)
@@ -180,6 +186,19 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
          mkWeakThreadId t >>= atomically . modifyTVar' (endThreads c) . IM.insert tId
          atomically $ TM.lookupDelete qId (clientSubs c)

+    receiveFromProxyAgent :: ProxyAgent -> M ()
+    receiveFromProxyAgent ProxyAgent {smpAgent = SMPClientAgent {agentQ}} =
+      forever $
+        atomically (readTBQueue agentQ) >>= \case
+          CAConnected srv -> logInfo $ "SMP server connected " <> showServer' srv
+          CADisconnected srv [] -> logInfo $ "SMP server disconnected " <> showServer' srv
+          CADisconnected srv subs -> logError $ "SMP server disconnected " <> showServer' srv <> " / subscriptions: " <> tshow (length subs)
+          CAReconnected srv -> logInfo $ "SMP server reconnected " <> showServer' srv
+          CAResubscribed srv subs -> logError $ "SMP server resubscribed " <> showServer' srv <> " / subscriptions: " <> tshow (length subs)
+          CASubError srv errs -> logError $ "SMP server subscription errors " <> showServer' srv <> " / errors: " <> tshow (length errs)
+      where
+        showServer' = decodeLatin1 . strEncode . host
+
    expireMessagesThread_ :: ServerConfig -> [M ()]
    expireMessagesThread_ ServerConfig {messageExpiration = Just msgExp} = [expireMessages msgExp]
    expireMessagesThread_ _ = []
@@ -315,7 +334,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
              CPResume -> withAdminRole $ hPutStrLn h "resume not implemented"
              CPClients -> withAdminRole $ do
                active <- unliftIO u (asks clients) >>= readTVarIO
-                hPutStrLn h $ "clientId,sessionId,connected,createdAt,rcvActiveAt,sndActiveAt,age,subscriptions"
+                hPutStrLn h "clientId,sessionId,connected,createdAt,rcvActiveAt,sndActiveAt,age,subscriptions"
                forM_ (IM.toList active) $ \(cid, Client {sessionId, connected, createdAt, rcvActiveAt, sndActiveAt, subscriptions}) -> do
                  connected' <- bshow <$> readTVarIO connected
                  rcvActiveAt' <- strEncode <$> readTVarIO rcvActiveAt
@@ -411,7 +430,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                    hPutStrLn h "AUTH"

 runClientTransport :: Transport c => THandleSMP c 'TServer -> M ()
-runClientTransport h@THandle {params = THandleParams {thVersion, sessionId}} = do
+runClientTransport h@THandle {params = thParams@THandleParams {thVersion, sessionId}} = do
  q <- asks $ tbqSize . config
  ts <- liftIO getSystemTime
  active <- asks clients
@@ -424,7 +443,7 @@ runClientTransport h@THandle {params = THandleParams {thVersion, sessionId}} = d
  expCfg <- asks $ inactiveClientExpiration . config
  th <- newMVar h -- put TH under a fair lock to interleave messages and command responses
  labelMyThread . B.unpack $ "client $" <> encode sessionId
-  raceAny_ ([liftIO $ send th c, liftIO $ sendMsg th c, client c s, receive h c] <> disconnectThread_ c expCfg)
+  raceAny_ ([liftIO $ send th c, liftIO $ sendMsg th c, client thParams c s, receive h c] <> disconnectThread_ c expCfg)
    `finally` clientDisconnected c
  where
    disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport h (rcvActiveAt c) (sndActiveAt c) expCfg (noSubscriptions c)]
@@ -465,19 +484,19 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
  forever $ do
    ts <- L.toList <$> liftIO (tGet h)
    atomically . writeTVar rcvActiveAt =<< liftIO getSystemTime
-    as <- partitionEithers <$> mapM cmdAction ts
-    write sndQ $ fst as
-    write rcvQ $ snd as
+    (errs, cmds) <- partitionEithers <$> mapM cmdAction ts
+    write sndQ errs
+    write rcvQ cmds
  where
    cmdAction :: SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
-    cmdAction (tAuth, authorized, (corrId, queueId, cmdOrError)) =
+    cmdAction (tAuth, authorized, (corrId, entId, cmdOrError)) =
      case cmdOrError of
-        Left e -> pure $ Left (corrId, queueId, ERR e)
-        Right cmd -> verified <$> verifyTransmission ((,C.cbNonce (bs corrId)) <$> thAuth) tAuth authorized queueId cmd
+        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 -> Right (qr, (corrId, queueId, cmd))
-              VRFailed -> Left (corrId, queueId, ERR AUTH)
+              VRVerified qr -> Right (qr, (corrId, entId, cmd))
+              VRFailed -> Left (corrId, entId, ERR AUTH)
    write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty

 send :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO ()
@@ -545,16 +564,18 @@ verifyTransmission auth_ tAuth authorized queueId cmd =
    -- SEND will be accepted without authorization before the queue is secured with KEY command
    Cmd SSender SEND {} -> verifyQueue (\q -> Just q `verified` maybe (isNothing tAuth) verify (senderKey q)) <$> get SSender
    Cmd SSender PING -> pure $ VRVerified Nothing
+    Cmd SSender RFWD {} -> pure $ VRVerified Nothing
    -- NSUB will not be accepted without authorization
-    Cmd SNotifier NSUB -> verifyQueue (\q -> maybe dummyVerify (Just q `verifiedWith`) (notifierKey <$> notifier q)) <$> get SNotifier
+    Cmd SNotifier NSUB -> verifyQueue (\q -> maybe dummyVerify (\n -> Just q `verifiedWith` notifierKey n) (notifier q)) <$> get SNotifier
+    Cmd SProxiedClient _ -> pure $ VRVerified Nothing
  where
    verify = verifyCmdAuthorization auth_ tAuth authorized
    dummyVerify = verify (dummyAuthKey tAuth) `seq` VRFailed
    verifyQueue :: (QueueRec -> VerificationResult) -> Either ErrorType QueueRec -> VerificationResult
-    verifyQueue = either (\_ -> dummyVerify)
+    verifyQueue = either (const dummyVerify)
    verified q cond = if cond then VRVerified q else VRFailed
    verifiedWith q k = q `verified` verify k
-    get :: SParty p -> M (Either ErrorType QueueRec)
+    get :: DirectParty p => SParty p -> M (Either ErrorType QueueRec)
    get party = do
      st <- asks queueStore
      atomically $ getQueue st party queueId
@@ -604,25 +625,65 @@ dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/Xo
 dummyKeyX25519 :: C.PublicKey 'C.X25519
 dummyKeyX25519 = "MCowBQYDK2VuAyEA4JGSMYht18H4mas/jHeBwfcM7jLwNYJNOAhi2/g4RXg="

-client :: Client -> Server -> M ()
-client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} Server {subscribedQ, ntfSubscribedQ, notifiers} = do
+client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
+client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} Server {subscribedQ, ntfSubscribedQ, notifiers} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
-  forever $
-    atomically (readTBQueue rcvQ)
-      >>= mapM processCommand
-      >>= atomically . writeTBQueue sndQ
+  forever $ do
+    (proxied, rs) <- partitionEithers . L.toList <$> (mapM processCommand =<< atomically (readTBQueue rcvQ))
+    forM_ (L.nonEmpty rs) reply
+    -- TODO cancel this thread if the client gets disconnected
+    -- TODO limit client concurrency
+    forM_ (L.nonEmpty proxied) $ \cmds -> forkIO $ mapConcurrently processProxiedCmd cmds >>= reply
  where
-    processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Transmission BrokerMsg)
+    reply :: MonadIO m => NonEmpty (Transmission BrokerMsg) -> m ()
+    reply = atomically . writeTBQueue sndQ
+    processProxiedCmd :: Transmission (Command 'ProxiedClient) -> M (Transmission BrokerMsg)
+    processProxiedCmd (corrId, sessId, command) = (corrId, sessId,) <$> case command of
+      PRXY srv auth -> ifM allowProxy getRelay (pure $ ERR $ PROXY BASIC_AUTH)
+        where
+          allowProxy = do
+            ServerConfig {allowSMPProxy, newQueueBasicAuth} <- asks config
+            pure $ allowSMPProxy && maybe True ((== auth) . Just) newQueueBasicAuth
+          getRelay = do
+            ProxyAgent {smpAgent} <- asks proxyAgent
+            liftIO $ proxyResp <$> runExceptT (getSMPServerClient' smpAgent srv) `catch` (pure . Left . PCEIOError)
+            where
+              proxyResp = \case
+                Left err -> ERR $ smpProxyError err
+                Right smp ->
+                  let THandleParams {sessionId = srvSessId, thVersion, thServerVRange, thAuth} = thParams smp
+                   in case compatibleVRange thServerVRange proxiedSMPRelayVRange of
+                        -- Cap the destination relay version range to prevent client version fingerprinting.
+                        -- See comment for proxiedSMPRelayVersion.
+                        Just (Compatible vr) | thVersion >= sendingProxySMPVersion -> case thAuth of
+                          Just THAuthClient {serverCertKey} -> PKEY srvSessId vr serverCertKey
+                          Nothing -> ERR $ transportErr TENoServerAuth
+                        _ -> ERR $ transportErr TEVersion                    
+      PFWD fwdV pubKey encBlock -> do
+        ProxyAgent {smpAgent} <- asks proxyAgent
+        atomically (lookupSMPServerClient smpAgent sessId) >>= \case
+          Just smp
+            | v >= sendingProxySMPVersion ->
+                liftIO $ either (ERR . smpProxyError) PRES <$>
+                   runExceptT (forwardSMPMessage smp corrId fwdV pubKey encBlock) `catchError` (pure . Left . PCEIOError)
+            | otherwise -> pure . ERR $ transportErr TEVersion
+            where
+              THandleParams {thVersion = v} = thParams smp
+          Nothing -> pure $ ERR $ PROXY NO_SESSION
+    transportErr :: TransportError -> ErrorType
+    transportErr = PROXY . BROKER . TRANSPORT
+    processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Either (Transmission (Command 'ProxiedClient)) (Transmission BrokerMsg))
    processCommand (qr_, (corrId, queueId, cmd)) = do
      st <- asks queueStore
      case cmd of
-        Cmd SSender command ->
-          case command of
-            SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
-            PING -> pure (corrId, "", PONG)
-        Cmd SNotifier NSUB -> subscribeNotifications
+        Cmd SProxiedClient command -> pure $ Left (corrId, queueId, command)
+        Cmd SSender command -> Right <$> case command of
+          SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
+          PING -> pure (corrId, "", PONG)
+          RFWD encBlock -> (corrId, "",) <$> processForwardedCommand encBlock
+        Cmd SNotifier NSUB -> Right <$> subscribeNotifications
        Cmd SRecipient command ->
-          case command of
+          Right <$> case command of
            NEW rKey dhKey auth subMode ->
              ifM
                allowNew
@@ -828,7 +889,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} Serv

        sendMessage :: QueueRec -> MsgFlags -> MsgBody -> M (Transmission BrokerMsg)
        sendMessage qr msgFlags msgBody
-          | B.length msgBody > maxMessageLength = pure $ err LARGE_MSG
+          | B.length msgBody > maxMessageLength thVersion = pure $ err LARGE_MSG
          | otherwise = case status qr of
              QueueOff -> return $ err AUTH
              QueueActive ->
@@ -852,6 +913,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} Serv
                        atomically $ updatePeriodStats (activeQueues stats) (recipientId qr)
                        pure ok
          where
+            THandleParams {thVersion} = thParams'
            mkMessage :: C.MaxLenBS MaxMessageLen -> M Message
            mkMessage body = do
              msgId <- randomId =<< asks (msgIdBytes . config)
@@ -886,6 +948,56 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} Serv
                  encNMsgMeta = C.cbEncrypt rcvNtfDhSecret cbNonce (smpEncode msgMeta) 128
              pure . (cbNonce,) $ fromRight "" encNMsgMeta

+        processForwardedCommand :: EncFwdTransmission -> M BrokerMsg
+        processForwardedCommand (EncFwdTransmission s) = fmap (either ERR id) . runExceptT $ do
+          THAuthServer {serverPrivKey, sessSecret'} <- maybe (throwE $ transportErr TENoServerAuth) pure (thAuth thParams')
+          sessSecret <- maybe (throwE $ transportErr TENoServerAuth) pure sessSecret'
+          let proxyNonce = C.cbNonce $ bs corrId
+          s' <- liftEitherWith (const CRYPTO) $ C.cbDecryptNoPad sessSecret proxyNonce s
+          FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission et} <- liftEitherWith (const $ CMD SYNTAX) $ smpDecode s'
+          let clientSecret = C.dh' fwdKey serverPrivKey
+              clientNonce = C.cbNonce $ bs fwdCorrId
+          b <- liftEitherWith (const CRYPTO) $ C.cbDecrypt clientSecret clientNonce et
+          let clntTHParams = smpTHParamsSetVersion fwdVersion thParams'
+          -- only allowing single forwarded transactions
+          t' <- case tParse clntTHParams b of
+            t :| [] -> pure $ tDecodeParseValidate clntTHParams t
+            _ -> throwE BLOCK
+          let clntThAuth = Just $ THAuthServer {serverPrivKey, sessSecret' = Just clientSecret}
+          -- process forwarded SEND
+          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
+                  fromRight (corrId', entId', ERR INTERNAL) <$> lift (processCommand t'')
+                _ ->
+                  pure (corrId', entId', ERR $ CMD PROHIBITED)
+          -- 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
+            TBError _ _ : _ -> throwE BLOCK
+            TBTransmission b' _ : _ -> pure b'
+            TBTransmissions b' _ _ : _ -> pure b'
+          -- encrypt to client
+          r2 <- liftEitherWith (const BLOCK) $ EncResponse <$> C.cbEncrypt clientSecret (C.reverseNonce clientNonce) r' paddedProxiedMsgLength
+          -- encrypt to proxy
+          let fr = FwdResponse {fwdCorrId, fwdResponse = r2}
+              r3 = EncFwdResponse $ C.cbEncryptNoPad sessSecret (C.reverseNonce proxyNonce) (smpEncode fr)
+          pure $ RRES r3
+          where
+            rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
+            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'
+                  where
+                    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
@@ -22,6 +22,7 @@ import Network.Socket (ServiceName)
 import qualified Network.TLS as T
 import Numeric.Natural
 import Simplex.Messaging.Agent.Lock
+import Simplex.Messaging.Client.Agent (SMPClientAgent, SMPClientAgentConfig, newSMPClientAgent)
 import Simplex.Messaging.Crypto (KeyHash (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
@@ -79,7 +80,9 @@ data ServerConfig = ServerConfig
    -- | TCP transport config
    transportConfig :: TransportServerConfig,
    -- | run listener on control port
-    controlPort :: Maybe ServiceName
+    controlPort :: Maybe ServiceName,
+    smpAgentCfg :: SMPClientAgentConfig,
+    allowSMPProxy :: Bool -- auth is the same with `newQueueBasicAuth`
  }

 defMsgExpirationDays :: Int64
@@ -110,8 +113,9 @@ data Env = Env
    tlsServerParams :: T.ServerParams,
    serverStats :: ServerStats,
    sockets :: SocketState,
-    clientSeq :: TVar Int,
-    clients :: TVar (IntMap Client)
+    clientSeq :: TVar ClientId,
+    clients :: TVar (IntMap Client),
+    proxyAgent :: ProxyAgent -- senders served on this proxy
  }

 data Server = Server
@@ -122,8 +126,14 @@ data Server = Server
    savingLock :: Lock
  }

+data ProxyAgent = ProxyAgent
+  { smpAgent :: SMPClientAgent
+  }
+
+type ClientId = Int
+
 data Client = Client
-  { clientId :: Int,
+  { clientId :: ClientId,
    subscriptions :: TMap RecipientId (TVar Sub),
    ntfSubscriptions :: TMap NotifierId (),
    rcvQ :: TBQueue (NonEmpty (Maybe QueueRec, Transmission Cmd)),
@@ -155,7 +165,7 @@ newServer = do
  savingLock <- createLock
  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, savingLock}

-newClient :: TVar Int -> Natural -> VersionSMP -> ByteString -> SystemTime -> STM Client
+newClient :: TVar ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> STM Client
 newClient nextClientId qSize thVersion sessionId createdAt = do
  clientId <- stateTVar nextClientId $ \next -> (next, next + 1)
  subscriptions <- TM.empty
@@ -176,7 +186,7 @@ newSubscription subThread = do
  return Sub {subThread, delivered}

 newEnv :: ServerConfig -> IO Env
-newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile, storeLogFile, transportConfig} = do
+newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile, storeLogFile, smpAgentCfg, transportConfig} = do
  server <- atomically newServer
  queueStore <- atomically newQueueStore
  msgStore <- atomically newMsgStore
@@ -189,7 +199,8 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
  sockets <- atomically newSocketState
  clientSeq <- newTVarIO 0
  clients <- newTVarIO mempty
-  return Env {config, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerParams, serverStats, sockets, clientSeq, clients}
+  proxyAgent <- atomically $ newSMPProxyAgent smpAgentCfg random
+  return Env {config, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerParams, serverStats, sockets, clientSeq, clients, proxyAgent}
  where
    restoreQueues :: QueueStore -> FilePath -> IO (StoreLog 'WriteMode)
    restoreQueues QueueStore {queues, senders, notifiers} f = do
@@ -205,3 +216,8 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
    addNotifier q = case notifier q of
      Nothing -> id
      Just NtfCreds {notifierId} -> M.insert notifierId (recipientId q)
+
+newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> STM ProxyAgent
+newSMPProxyAgent smpAgentCfg random = do
+  smpAgent <- newSMPClientAgent smpAgentCfg random
+  pure ProxyAgent {smpAgent}
@@ -14,10 +14,13 @@ import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
 import Data.Maybe (fromMaybe)
+import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Network.Socket (HostName)
 import Options.Applicative
+import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
+import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
@@ -25,10 +28,11 @@ import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defMsgExpirationDays, defaultInactiveClientExpiration, defaultMessageExpiration)
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Transport (simplexMQVersion, supportedSMPHandshakes, supportedServerSMPRelayVRange)
+import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedSMPHandshakes, supportedServerSMPRelayVRange)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
 import Simplex.Messaging.Util (safeDecodeUtf8)
+import Simplex.Messaging.Version (mkVersionRange)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
@@ -129,7 +133,7 @@ smpServerCLI cfgPath logPath =
                   )
                <> "\n\n\
                   \# control_port_admin_password:\n\
-                   \# control_port_user_password:\n\
+                   \# control_port_user_password:\n\n\
                   \[TRANSPORT]\n\
                   \# host is only used to print server address on start\n"
                <> ("host: " <> host <> "\n")
@@ -137,6 +141,18 @@ smpServerCLI cfgPath logPath =
                <> "log_tls_errors: off\n\
                   \websockets: off\n\
                   \# control_port: 5224\n\n\
+                   \[PROXY]\n\
+                   \# Network configuration for SMP proxy client.\n\
+                   \# `host_mode` can be 'public' (default) or 'onion'.\n\
+                   \# It defines prefferred hostname for destination servers with multiple hostnames.\n\
+                   \# host_mode: public\n\
+                   \# required_host_mode: off\n\n\
+                   \# SOCKS proxy port for forwarding messages to destination servers.\n\
+                   \# You may need a separate instance of SOCKS proxy for incoming single-hop requests.\n\
+                   \# socks_proxy: localhost:9050\n\n\
+                   \# `socks_mode` can be 'onion' for SOCKS proxy to be used for .onion destination hosts only (default)\n\
+                   \# or 'always' to be used for all destination hosts (can be used if it is an .onion server).\n\
+                   \# socks_mode: onion\n\n\
                   \[INACTIVE_CLIENTS]\n\
                   \# TTL and interval to check inactive clients\n\
                   \disconnect: off\n"
@@ -214,8 +230,34 @@ smpServerCLI cfgPath logPath =
                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini,
                    alpn = Just supportedSMPHandshakes
                  },
-              controlPort = either (const Nothing) (Just . T.unpack) $ lookupValue "TRANSPORT" "control_port" ini
+              controlPort = either (const Nothing) (Just . T.unpack) $ lookupValue "TRANSPORT" "control_port" ini,
+              smpAgentCfg =
+                defaultSMPClientAgentConfig
+                  { smpCfg =
+                      (smpCfg defaultSMPClientAgentConfig)
+                        { serverVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion,
+                          agreeSecret = True,
+                          networkConfig =
+                            defaultNetworkConfig
+                              { socksProxy = either error id <$> strDecodeIni "PROXY" "socks_proxy" ini,
+                                socksMode = either (const SMOnion) textToSocksMode $ lookupValue "PROXY" "socks_mode" ini,
+                                hostMode = either (const HMPublic) textToHostMode $ lookupValue "PROXY" "host_mode" ini,
+                                requiredHostMode = fromMaybe False $ iniOnOff "PROXY" "required_host_mode" ini
+                              }
+                        }
+                  },
+              allowSMPProxy = True
            }
+        textToSocksMode :: Text -> SocksMode
+        textToSocksMode = \case
+          "always" -> SMAlways
+          "onion" -> SMOnion
+          s -> error . T.unpack $ "Invalid socks_mode: " <> s
+        textToHostMode :: Text -> HostMode
+        textToHostMode = \case
+          "public" -> HMPublic
+          "onion" -> HMOnionViaSocks
+          s -> error . T.unpack $ "Invalid host_mode: " <> s

 data CliCommand
  = Init InitOptions
@@ -306,4 +348,3 @@ cliCommandP cfgPath logPath iniFile =
      pure InitOptions {enableStoreLog, logStats, signAlgorithm, ip, fqdn, password, scripted}
    parseBasicAuth :: ReadM ServerPassword
    parseBasicAuth = eitherReader $ fmap ServerPassword . strDecode . B.pack
-
@@ -54,7 +54,7 @@ addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId =
  where
    hasId = (||) <$> TM.member rId queues <*> TM.member sId senders

-getQueue :: QueueStore -> SParty p -> QueueId -> STM (Either ErrorType QueueRec)
+getQueue :: DirectParty p => QueueStore -> SParty p -> QueueId -> STM (Either ErrorType QueueRec)
 getQueue QueueStore {queues, senders, notifiers} party qId =
  toResult <$> (mapM readTVar =<< getVar)
  where
@@ -36,6 +36,7 @@ module Simplex.Messaging.Transport
    supportedSMPHandshakes,
    supportedClientSMPRelayVRange,
    supportedServerSMPRelayVRange,
+    proxiedSMPRelayVRange,
    legacyServerSMPRelayVRange,
    currentClientSMPRelayVersion,
    legacyServerSMPRelayVersion,
@@ -44,6 +45,7 @@ module Simplex.Messaging.Transport
    basicAuthSMPVersion,
    subModeSMPVersion,
    authCmdsSMPVersion,
+    sendingProxySMPVersion,
    simplexMQVersion,
    smpBlockSize,
    TransportConfig (..),
@@ -74,14 +76,13 @@ module Simplex.Messaging.Transport
    smpClientHandshake,
    tPutBlock,
    tGetBlock,
-    serializeTransportError,
-    transportErrorP,
    sendHandshake,
    getHandshake,
+    smpTHParamsSetVersion,
  )
 where

-import Control.Applicative (optional, (<|>))
+import Control.Applicative (optional)
 import Control.Monad (forM)
 import Control.Monad.Except
 import Control.Monad.Trans.Except (throwE)
@@ -152,14 +153,25 @@ subModeSMPVersion = VersionSMP 6
 authCmdsSMPVersion :: VersionSMP
 authCmdsSMPVersion = VersionSMP 7

+sendingProxySMPVersion :: VersionSMP
+sendingProxySMPVersion = VersionSMP 8
+
 currentClientSMPRelayVersion :: VersionSMP
-currentClientSMPRelayVersion = VersionSMP 7
+currentClientSMPRelayVersion = VersionSMP 8

 legacyServerSMPRelayVersion :: VersionSMP
 legacyServerSMPRelayVersion = VersionSMP 6

 currentServerSMPRelayVersion :: VersionSMP
-currentServerSMPRelayVersion = VersionSMP 7
+currentServerSMPRelayVersion = VersionSMP 8
+
+-- Max SMP protocol version to be used in e2e encrypted
+-- connection between client and server, as defined by SMP proxy.
+-- SMP proxy sets it to lower than its current version
+-- to prevent client version fingerprinting by the
+-- destination relays when clients upgrade at different times.
+proxiedSMPRelayVersion :: VersionSMP
+proxiedSMPRelayVersion = VersionSMP 8

 -- minimal supported protocol version is 4
 -- TODO remove code that supports sending commands without batching
@@ -172,6 +184,10 @@ legacyServerSMPRelayVRange = mkVersionRange batchCmdsSMPVersion legacyServerSMPR
 supportedServerSMPRelayVRange :: VersionRangeSMP
 supportedServerSMPRelayVRange = mkVersionRange batchCmdsSMPVersion currentServerSMPRelayVersion

+-- This range initially allows only version 8 - see the comment above.
+proxiedSMPRelayVRange :: VersionRangeSMP
+proxiedSMPRelayVRange = mkVersionRange sendingProxySMPVersion proxiedSMPRelayVersion
+
 supportedSMPHandshakes :: [ALPN]
 supportedSMPHandshakes = ["smp/1"]

@@ -338,6 +354,8 @@ type THandleSMP c p = THandle SMPVersion c p
 data THandleParams v p = THandleParams
  { sessionId :: SessionId,
    blockSize :: Int,
+    -- | server protocol version range
+    thServerVRange :: VersionRange v,
    -- | agreed server protocol version
    thVersion :: Version v,
    -- | peer public key for command authorization and shared secrets for entity ID encryption
@@ -370,6 +388,7 @@ data ServerHandshake = ServerHandshake
  { smpVersionRange :: VersionRangeSMP,
    sessionId :: SessionId,
    -- pub key to agree shared secrets for command authorization and entity ID encryption.
+    -- todo C.PublicKeyX25519
    authPubKey :: Maybe (X.CertificateChain, X.SignedExact X.PubKey)
  }

@@ -421,6 +440,8 @@ authEncryptCmdsP v p = if v >= authCmdsSMPVersion then optional p else pure Noth
 data TransportError
  = -- | error parsing transport block
    TEBadBlock
+  | -- | incompatible client or server version
+    TEVersion
  | -- | message does not fit in transport block
    TELargeMsg
  | -- | incorrect session ID
@@ -436,31 +457,29 @@ data TransportError
 data HandshakeError
  = -- | parsing error
    PARSE
-  | -- | incompatible peer version
-    VERSION
  | -- | incorrect server identity
    IDENTITY
  | -- | v7 authentication failed
    BAD_AUTH
  deriving (Eq, Read, Show, Exception)

-- | SMP encrypted transport error parser.
-transportErrorP :: Parser TransportError
-transportErrorP =
-  "BLOCK" $> TEBadBlock
-    <|> "LARGE_MSG" $> TELargeMsg
-    <|> "SESSION" $> TEBadSession
-    <|> "NO_AUTH" $> TENoServerAuth
-    <|> "HANDSHAKE " *> (TEHandshake <$> parseRead1)
-
-- | Serialize SMP encrypted transport error.
-serializeTransportError :: TransportError -> ByteString
-serializeTransportError = \case
-  TEBadBlock -> "BLOCK"
-  TELargeMsg -> "LARGE_MSG"
-  TEBadSession -> "SESSION"
-  TENoServerAuth -> "NO_AUTH"
-  TEHandshake e -> "HANDSHAKE " <> bshow e
+instance Encoding TransportError where
+  smpP =
+    A.takeTill (== ' ') >>= \case
+      "BLOCK" -> pure TEBadBlock
+      "VERSION" -> pure TEVersion
+      "LARGE_MSG" -> pure TELargeMsg
+      "SESSION" -> pure TEBadSession
+      "NO_AUTH" -> pure TENoServerAuth
+      "HANDSHAKE" -> TEHandshake <$> (A.space *> parseRead1)
+      _ -> fail "bad TransportError"
+  smpEncode = \case
+    TEBadBlock -> "BLOCK"
+    TEVersion -> "VERSION"
+    TELargeMsg -> "LARGE_MSG"
+    TEBadSession -> "SESSION"
+    TENoServerAuth -> "NO_AUTH"
+    TEHandshake e -> "HANDSHAKE " <> bshow e

 -- | Pad and send block to SMP transport.
 tPutBlock :: Transport c => THandle v c p -> ByteString -> IO (Either TransportError ())
@@ -490,9 +509,10 @@ smpServerHandshake serverSignKey c (k, pk) kh smpVRange = do
    ClientHandshake {smpVersion = v, keyHash, authPubKey = k'}
      | keyHash /= kh ->
          throwE $ TEHandshake IDENTITY
-      | v `isCompatible` smpVersionRange ->
-          pure $ smpThHandleServer th v pk k'
-      | otherwise -> throwE $ TEHandshake VERSION
+      | otherwise ->
+          case compatibleVRange' smpVersionRange v of
+            Just (Compatible vr) -> pure $ smpTHandleServer th v vr pk k'
+            Nothing -> throwE TEVersion

 -- | Client SMP transport handshake.
 --
@@ -503,8 +523,8 @@ smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange = do
  ServerHandshake {sessionId = sessId, smpVersionRange, authPubKey} <- getHandshake th
  if sessionId /= sessId
    then throwE TEBadSession
-    else case smpVersionRange `compatibleVersion` smpVRange of
-      Just (Compatible v) -> do
+    else case smpVersionRange `compatibleVRange` smpVRange of
+      Just (Compatible vr) -> do
        ck_ <- forM authPubKey $ \certKey@(X.CertificateChain cert, exact) ->
          liftEitherWith (const $ TEHandshake BAD_AUTH) $ do
            case cert of
@@ -513,26 +533,33 @@ smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange = do
            serverKey <- getServerVerifyKey c
            pubKey <- C.verifyX509 serverKey exact
            (,certKey) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey)
+        let v = maxVersion vr
        sendHandshake th $ ClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_}
-        pure $ smpThHandleClient th v (snd <$> ks_) ck_
-      Nothing -> throwE $ TEHandshake VERSION
+        pure $ smpTHandleClient th v vr (snd <$> ks_) ck_
+      Nothing -> throwE TEVersion

-smpThHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> THandleSMP c 'TServer
-smpThHandleServer th v pk k_ =
+smpTHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRangeSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> THandleSMP c 'TServer
+smpTHandleServer th v vr pk k_ =
  let thAuth = THAuthServer {serverPrivKey = pk, sessSecret' = (`C.dh'` pk) <$> k_}
-   in smpThHandle_ th v (Just thAuth)
+   in smpTHandle_ th v vr (Just thAuth)

-smpThHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> THandleSMP c 'TClient
-smpThHandleClient th v pk_ ck_ =
+smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> THandleSMP c 'TClient
+smpTHandleClient th v vr pk_ ck_ =
  let thAuth = (\(k, ck) -> THAuthClient {serverPeerPubKey = k, serverCertKey = ck, sessSecret = C.dh' k <$> pk_}) <$> ck_
-   in smpThHandle_ th v thAuth
+   in smpTHandle_ th v vr thAuth

-smpThHandle_ :: forall c p. THandleSMP c p -> VersionSMP -> Maybe (THandleAuth p) -> THandleSMP c p
-smpThHandle_ th@THandle {params} v thAuth =
+smpTHandle_ :: forall c p. THandleSMP c p -> VersionSMP -> VersionRangeSMP -> Maybe (THandleAuth p) -> THandleSMP c p
+smpTHandle_ th@THandle {params} v vr thAuth =
  -- TODO drop SMP v6: make thAuth non-optional
-  let params' = params {thVersion = v, thAuth, implySessId = v >= authCmdsSMPVersion}
+  let params' = params {thVersion = v, thServerVRange = vr, thAuth, implySessId = v >= authCmdsSMPVersion}
   in (th :: THandleSMP c p) {params = params'}

+-- This function is only used with v >= 8, so currently it's a simple record update.
+-- It may require some parameters update in the future, to be consistent with smpTHandle_.
+smpTHParamsSetVersion :: VersionSMP -> THandleParams SMPVersion p -> THandleParams SMPVersion p
+smpTHParamsSetVersion v params = params {thVersion = v}
+{-# INLINE smpTHParamsSetVersion #-}
+
 sendHandshake :: (Transport c, Encoding smp) => THandle v c p -> smp -> ExceptT TransportError IO ()
 sendHandshake th = ExceptT . tPutBlock th . smpEncode

@@ -543,7 +570,17 @@ getHandshake th = ExceptT $ (first (\_ -> TEHandshake PARSE) . A.parseOnly smpP
 smpTHandle :: Transport c => c -> THandleSMP c p
 smpTHandle c = THandle {connection = c, params}
  where
-    params = THandleParams {sessionId = tlsUnique c, blockSize = smpBlockSize, thVersion = VersionSMP 0, thAuth = Nothing, implySessId = False, batch = True}
+    v = VersionSMP 0
+    params =
+      THandleParams
+        { sessionId = tlsUnique c,
+          blockSize = smpBlockSize,
+          thServerVRange = versionToRange v,
+          thVersion = v,
+          thAuth = Nothing,
+          implySessId = False,
+          batch = True
+        }

 $(J.deriveJSON (sumTypeJSON id) ''HandshakeError)

@@ -23,6 +23,8 @@ module Simplex.Messaging.Version
    isCompatibleRange,
    proveCompatible,
    compatibleVersion,
+    compatibleVRange,
+    compatibleVRange',
  )
 where

@@ -98,6 +100,7 @@ class VersionScope v => VersionI v a | a -> v where
 class VersionScope v => VersionRangeI v a | a -> v where
  type VersionT v a
  versionRange :: a -> VersionRange v
+  toVersionRange :: a -> VersionRange v -> a
  toVersionT :: a -> Version v -> VersionT v a

 instance VersionScope v => VersionI v (Version v) where
@@ -108,6 +111,7 @@ instance VersionScope v => VersionI v (Version v) where
 instance VersionScope v => VersionRangeI v (VersionRange v) where
  type VersionT v (VersionRange v) = Version v
  versionRange = id
+  toVersionRange _ vr = vr
  toVersionT _ v = v

 newtype Compatible a = Compatible_ a
@@ -135,5 +139,24 @@ compatibleVersion x vr =
    max1 = maxVersion $ versionRange x
    max2 = maxVersion vr

+-- | intersection of version ranges
+compatibleVRange :: VersionRangeI v a => a -> VersionRange v -> Maybe (Compatible a)
+compatibleVRange x vr =
+  compatibleVRange_ x (max min1 min2) (min max1 max2)
+  where
+    VRange min1 max1 = versionRange x
+    VRange min2 max2 = vr
+
+-- | version range capped by compatible version
+compatibleVRange' :: VersionRangeI v a => a -> Version v -> Maybe (Compatible a)
+compatibleVRange' x v
+  | v <= max1 = compatibleVRange_ x min1 v
+  | otherwise = Nothing
+  where
+    VRange min1 max1 = versionRange x
+
+compatibleVRange_ :: VersionRangeI v a => a -> Version v -> Version v -> Maybe (Compatible a)
+compatibleVRange_ x v1 v2 = Compatible_ . toVersionRange x <$> safeVersionRange v1 v2
+
 mkCompatibleIf :: a -> Bool -> Maybe (Compatible a)
 x `mkCompatibleIf` cond = if cond then Just $ Compatible_ x else Nothing