proxy: agent implementation (#1106)

* proxy: agent implementation

* revert change

* update rfc

* test stuck subscription mock

* store proxy sessions inside SMP client var

* rename

* create and use proxy session

* tests

* return proxy in SENT event

* rename, more tests

* rename

* more tests

* remove comment

---------

Co-authored-by: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>

src/Simplex/Messaging/Agent.hs

@@ -149,7 +149,7 @@ import Simplex.FileTransfer.Protocol (FileParty (..))
 import Simplex.FileTransfer.Util (removePath)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
-import Simplex.Messaging.Agent.Lock (withLock', withLock)
+import Simplex.Messaging.Agent.Lock (withLock, withLock')
 import Simplex.Messaging.Agent.NtfSubSupervisor
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
@@ -160,7 +160,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Client (ProtocolClient (..), ServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs)
-import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOn, pattern PQEncOff, pattern PQSupportOn, pattern PQSupportOff)
+import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -198,7 +198,7 @@ getSMPAgentClient_ clientId cfg initServers store backgroundMode =
   liftIO $ newSMPAgentEnv cfg store >>= runReaderT runAgent
   where
     runAgent = do
-      c@AgentClient {acThread}  <- atomically . newAgentClient clientId initServers =<< ask
+      c@AgentClient {acThread} <- atomically . newAgentClient clientId initServers =<< ask
       t <- runAgentThreads c `forkFinally` const (liftIO $ disconnectAgentClient c)
       atomically . writeTVar acThread . Just =<< mkWeakThreadId t
       pure c
@@ -239,7 +239,7 @@ createUser c = withAgentEnv c .: createUser' c
 {-# INLINE createUser #-}
 
 -- | Delete user record optionally deleting all user's connections on SMP servers
-deleteUser :: AgentClient -> UserId -> Bool -> AE  ()
+deleteUser :: AgentClient -> UserId -> Bool -> AE ()
 deleteUser c = withAgentEnv c .: deleteUser' c
 {-# INLINE deleteUser #-}
 
@@ -815,7 +815,7 @@ joinConnSrv c userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMo
   lift (compatibleContactUri cReqUri pqSup) >>= \case
     Just (qInfo, vrsn) -> do
       (connId', cReq) <- newConnSrv c userId connId 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
 
@@ -1209,7 +1209,7 @@ enqueueMessage c cData sq msgFlags aMessage =
 {-# INLINE enqueueMessage #-}
 
 -- this function is used only for sending messages in batch, it returns the list of successes to enqueue additional deliveries
-enqueueMessageB :: forall t. (Traversable t) => AgentClient -> t (Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage)) -> AM' (t (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe (ConnData, [SndQueue], AgentMsgId))))
+enqueueMessageB :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage)) -> AM' (t (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe (ConnData, [SndQueue], AgentMsgId))))
 enqueueMessageB c reqs = do
   cfg <- asks config
   reqMids <- withStoreBatch c $ \db -> fmap (bindRight $ storeSentMsg db cfg) reqs
@@ -1242,7 +1242,7 @@ enqueueSavedMessage :: AgentClient -> ConnData -> AgentMsgId -> SndQueue -> AM'
 enqueueSavedMessage c cData msgId sq = enqueueSavedMessageB c $ Identity (cData, [sq], msgId)
 {-# INLINE enqueueSavedMessage #-}
 
-enqueueSavedMessageB :: (Foldable t) => AgentClient -> t (ConnData, [SndQueue], AgentMsgId) -> AM' ()
+enqueueSavedMessageB :: Foldable t => AgentClient -> t (ConnData, [SndQueue], AgentMsgId) -> AM' ()
 enqueueSavedMessageB c reqs = do
   -- saving to the database is in the start to avoid race conditions when delivery is read from queue before it is saved
   void $ withStoreBatch' c $ \db -> concatMap (storeDeliveries db) reqs
@@ -1333,7 +1333,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork
                 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
@@ -1355,7 +1355,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 ()
@@ -2212,7 +2212,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"
@@ -2574,7 +2574,7 @@ confirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do
 confirmQueue :: Compatible VersionSMPA -> AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
 confirmQueue (Compatible agentVersion) c cData@ConnData {connId, 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

src/Simplex/Messaging/Agent/Client.hs

@@ -132,6 +132,8 @@ module Simplex.Messaging.Agent.Client
     SMPTransportSession,
     NtfTransportSession,
     XFTPTransportSession,
+    ProxiedRelay (..),
+    SMPConnectedClient (..),
   )
 where
 
@@ -230,7 +232,7 @@ import Simplex.Messaging.Session
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPVersion)
-import Simplex.Messaging.Transport.Client (TransportHost)
+import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Mem.Weak (Weak)
@@ -263,6 +265,10 @@ data AgentClient = AgentClient
     msgQ :: TBQueue (ServerTransmission SMPVersion 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),
@@ -297,6 +303,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 #-}
@@ -428,6 +441,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
@@ -463,6 +477,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv =
         msgQ,
         smpServers,
         smpClients,
+        smpProxiedRelays,
         ntfServers,
         ntfClients,
         xftpServers,
@@ -511,15 +526,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 :: 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
@@ -529,6 +548,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
@@ -538,61 +559,120 @@ 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, 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, 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, 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 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 sess
+        Left e -> do
+          liftIO $ incClientStat c userId clnt "PROXY" $ strEncode e
+          atomically $ do
+            removeSessVar rv destSrv prs
+            TM.delete destSess smpProxiedRelays
+            putTMVar (sessionVar rv) (Left e)
+          throwError e -- signal error to caller
+    waitForProxiedRelay :: SMPTransportSession -> ProxiedRelayVar -> AM ProxiedRelay
+    waitForProxiedRelay (_, srv, _) rv = do
+      NetworkConfig {tcpConnectTimeout} <- atomically $ getNetworkConfig c
+      sess_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar rv)
+      liftEither $ 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 =
@@ -735,7 +815,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
@@ -842,7 +926,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 ()
@@ -895,6 +979,22 @@ 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
+  cp@(cl, _) <- getSMPProxyClient c destSess
+  logServer ("--> " <> proxySrv cl <> " >") c destSrv entId cmdStr
+  r <- (action cp <* stat cl "OK") `catchAgentError` logServerError cl
+  logServer ("<-- " <> proxySrv cl <> " <") c destSrv entId "OK"
+  pure r
+  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
@@ -903,22 +1003,46 @@ 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
+    unknownServer = maybe True (all ((destSrv /=) . protoServer)) <$> TM.lookup userId (userServers c)
+    sendViaProxy destSess =
+      withProxySession c destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess) -> do
+        liftClient SMP (clientServer smp) $ proxySMPMessage smp proxySess spKey_ senderId msgFlags msg
+        pure . Just $ protocolClientServer' smp
+    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)
@@ -989,7 +1113,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
@@ -1104,7 +1227,7 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
   logServer "-->" c srv "" "NEW"
   tSess <- liftIO $ mkTransportSession c userId srv connId
   QIK {rcvId, sndId, rcvPublicDhKey} <-
-    withClient c tSess "NEW" $ \smp -> createSMPQueue smp rKeys dhKey auth subMode
+    withClient c tSess "NEW" $ \smp -> createSMPQueue (connectedClient smp) rKeys dhKey auth subMode
   liftIO . logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
   let rq =
         RcvQueue
@@ -1193,7 +1316,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
@@ -1243,20 +1366,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
@@ -1340,12 +1460,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 =
@@ -1606,9 +1725,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
@@ -1616,7 +1739,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

src/Simplex/Messaging/Agent/Protocol.hs

@@ -193,13 +193,13 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet
   ( InitialKeys (..),
     PQEncryption (..),
-    pattern PQEncOff,
     PQSupport,
-    pattern PQSupportOn,
-    pattern PQSupportOff,
     RcvE2ERatchetParams,
     RcvE2ERatchetParamsUri,
-    SndE2ERatchetParams
+    SndE2ERatchetParams,
+    pattern PQEncOff,
+    pattern PQSupportOff,
+    pattern PQSupportOn,
   )
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -213,14 +213,14 @@ import Simplex.Messaging.Protocol
     MsgId,
     NMsgMeta,
     ProtocolServer (..),
+    SMPClientVersion,
     SMPMsgMeta,
     SMPServer,
     SMPServerWithAuth,
     SndPublicAuthKey,
     SubscriptionMode,
-    SMPClientVersion,
-    VersionSMPC,
     VersionRangeSMPC,
+    VersionSMPC,
     initialSMPClientVersion,
     legacyEncodeServer,
     legacyServerP,
@@ -398,7 +398,7 @@ 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
   MERR :: AgentMsgId -> AgentErrorType -> ACommand Agent AEConn
   MERRS :: NonEmpty AgentMsgId -> AgentErrorType -> ACommand Agent AEConn
   MSG :: MsgMeta -> MsgFlags -> MsgBody -> ACommand Agent AEConn
@@ -517,7 +517,7 @@ aCommandTag = \case
   RSYNC {} -> RSYNC_
   SEND {} -> SEND_
   MID {} -> MID_
-  SENT _ -> SENT_
+  SENT {} -> SENT_
   MERR {} -> MERR_
   MERRS {} -> MERRS_
   MSG {} -> MSG_
@@ -913,7 +913,7 @@ instance Encoding AgentMsgEnvelope where
 -- AgentRatchetInfo is not encrypted with double ratchet, but with per-queue E2E encryption
 data AgentMessage
   = -- used by the initiating party when confirming reply queue
-  AgentConnInfo ConnInfo
+    AgentConnInfo ConnInfo
   | -- AgentConnInfoReply is used by accepting party in duplexHandshake mode (v2), allowing to include reply queue(s) in the initial confirmation.
     -- It made removed REPLY message unnecessary.
     AgentConnInfoReply (NonEmpty SMPQueueInfo) ConnInfo
@@ -1387,9 +1387,9 @@ deriving instance Show (ConnectionRequestUri m)
 data AConnectionRequestUri = forall m. ConnectionModeI m => ACR (SConnectionMode m) (ConnectionRequestUri m)
 
 instance Eq AConnectionRequestUri where
-   ACR m cr == ACR m' cr' = case testEquality m m' of
-     Just Refl -> cr == cr'
-     _ -> False
+  ACR m cr == ACR m' cr' = case testEquality m m' of
+    Just Refl -> cr == cr'
+    _ -> False
 
 deriving instance Show AConnectionRequestUri
 
@@ -1793,7 +1793,7 @@ 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)
           MERR_ -> s (MERR <$> A.decimal <* A.space <*> strP)
           MERRS_ -> s (MERRS <$> strP_ <*> strP)
           MSG_ -> s (MSG <$> strP <* A.space <*> smpP <* A.space <*> binaryP)
@@ -1856,7 +1856,7 @@ 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_)
   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]

src/Simplex/Messaging/Client.hs

@@ -30,9 +30,11 @@ module Simplex.Messaging.Client
     TransportSession,
     ProtocolClient (thParams, sessionTs),
     SMPClient,
+    ProxiedRelay (..),
     getProtocolClient,
     closeProtocolClient,
     protocolClientServer,
+    protocolClientServer',
     transportHost',
     transportSession',
 
@@ -54,7 +56,7 @@ module Simplex.Messaging.Client
     suspendSMPQueue,
     deleteSMPQueue,
     deleteSMPQueues,
-    createSMPProxySession,
+    connectSMPProxiedRelay,
     proxySMPMessage,
     forwardSMPMessage,
     sendProtocolCommand,
@@ -65,6 +67,8 @@ module Simplex.Messaging.Client
     ProtocolClientConfig (..),
     NetworkConfig (..),
     TransportSessionMode (..),
+    HostMode (..),
+    SMPProxyMode (..),
     defaultClientConfig,
     defaultSMPClientConfig,
     defaultNetworkConfig,
@@ -207,6 +211,8 @@ data NetworkConfig = NetworkConfig
     requiredHostMode :: Bool,
     -- | transport sessions are created per user or per entity
     sessionMode :: TransportSessionMode,
+    -- | SMP proxy mode
+    smpProxyMode :: SMPProxyMode,
     -- | timeout for the initial client TCP/TLS connection (microseconds)
     tcpConnectTimeout :: Int,
     -- | timeout of protocol commands (microseconds)
@@ -226,6 +232,14 @@ 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)
+
 defaultNetworkConfig :: NetworkConfig
 defaultNetworkConfig =
   NetworkConfig
@@ -233,6 +247,7 @@ defaultNetworkConfig =
       hostMode = HMOnionViaSocks,
       requiredHostMode = False,
       sessionMode = TSMUser,
+      smpProxyMode = SPMNever,
       tcpConnectTimeout = 20_000_000,
       tcpTimeout = 15_000_000,
       tcpTimeoutPerKb = 5_000,
@@ -302,10 +317,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_
@@ -650,14 +669,13 @@ deleteSMPQueues = okSMPCommands DEL
 
 -- send PRXY :: SMPServer -> Maybe BasicAuth -> Command Sender
 -- receives PKEY :: SessionId -> X.CertificateChain -> X.SignedExact X.PubKey -> BrokerMsg
-createSMPProxySession :: SMPClient -> SMPServer -> Maybe BasicAuth -> ExceptT SMPClientError IO (SessionId, VersionSMP, C.PublicKeyX25519)
-createSMPProxySession c relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyAuth =
+connectSMPProxiedRelay :: SMPClient -> SMPServer -> Maybe BasicAuth -> ExceptT SMPClientError IO ProxiedRelay
+connectSMPProxiedRelay c relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyAuth =
   sendSMPCommand c Nothing "" (PRXY relayServ proxyAuth) >>= \case
-    -- XXX: rfc says sessionId should be in the entityId of response
     PKEY sId vr (chain, key) -> do
       case supportedClientSMPRelayVRange `compatibleVersion` vr of
         Nothing -> throwE PCEIncompatibleHost -- TODO different error
-        Just (Compatible v) -> liftEitherWith x509Error $ (sId,v,) <$> validateRelay chain key
+        Just (Compatible v) -> liftEitherWith x509Error $ ProxiedRelay sId v <$> validateRelay chain key
     r -> throwE . PCEUnexpectedResponse $ bshow r
   where
     x509Error :: String -> SMPClientError
@@ -672,6 +690,12 @@ createSMPProxySession c relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyA
       pubKey <- C.verifyX509 serverKey exact
       C.x509ToPublic (pubKey, []) >>= C.pubKey
 
+data ProxiedRelay = ProxiedRelay
+  { prSessionId :: SessionId,
+    prVersion :: VersionSMP,
+    prServerKey :: C.PublicKeyX25519
+  }
+
 -- 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
@@ -679,9 +703,7 @@ createSMPProxySession c relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyA
 proxySMPMessage ::
   SMPClient ->
   -- proxy session from PKEY
-  SessionId ->
-  VersionSMP ->
-  C.PublicKeyX25519 ->
+  ProxiedRelay ->
   -- message to deliver
   Maybe SndPrivateAuthKey ->
   SenderId ->
@@ -689,7 +711,7 @@ proxySMPMessage ::
   MsgBody ->
   ExceptT SMPClientError IO ()
 -- TODO use version
-proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g}} sessionId _v serverKey spKey sId flags msg = do
+proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g}} (ProxiedRelay sessionId _v serverKey) spKey sId flags msg = do
   -- prepare params
   let serverThAuth = (\ta -> ta {serverPeerPubKey = serverKey}) <$> thAuth proxyThParams
       serverThParams = proxyThParams {sessionId, thAuth = serverThAuth}
@@ -867,4 +889,6 @@ $(J.deriveJSON (enumJSON $ dropPrefix "HM") ''HostMode)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "TSM") ''TransportSessionMode)
 
+$(J.deriveJSON (enumJSON $ dropPrefix "SPM") ''SMPProxyMode)
+
 $(J.deriveJSON defaultJSON ''NetworkConfig)