version 3.2.0 (#499 )

support multiple server hosts with notifications (#498 )
* support multiple server hosts with notifications * remove unused type * remove unused import * update server hosts during parsing
2026-10-12 11:39:56 +00:00 · 2022-08-16 20:45:35 +01:00 · 2022-08-14 21:10:34 +01:00 · 2022-08-13 11:57:36 +01:00 · 2022-08-12 11:32:04 +01:00 · 2022-08-11 10:15:08 +01:00
32 changed files with 731 additions and 334 deletions
@@ -1,3 +1,11 @@
+# 3.2.0
+
+SMP agent:
+
+- Support multiple server hostnames (including onion hostnames) in server addresses.
+- Network configuration options.
+- Options to define rules to choose server hostname.
+
 # 3.1.0

 SMP server and agent:
@@ -45,7 +45,7 @@ ntfServerCLIConfig =
          fingerprintFile = combine cfgPath "fingerprint",
          defaultServerPort = "443",
          executableName = "ntf-server",
-          serverVersion = "SMP notifications server v1.1.3",
+          serverVersion = "SMP notifications server v1.2.0",
          mkIniFile = \enableStoreLog defaultServerPort ->
            "[STORE_LOG]\n\
            \# The server uses STM memory for persistence,\n\
@@ -1,4 +1,5 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}

@@ -8,6 +9,7 @@ import Control.Logger.Simple
 import qualified Data.List.NonEmpty as L
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Server (runSMPAgent)
+import Simplex.Messaging.Client (defaultNetworkConfig)
 import Simplex.Messaging.Transport (TLS, Transport (..))

 cfg :: AgentConfig
@@ -18,7 +20,7 @@ servers =
  InitialAgentServers
    { smp = L.fromList ["smp://bU0K-bRg24xWW__lS0umO1Zdw_SXqpJNtm1_RrPLViE=@localhost:5223"],
      ntf = [],
-      netCfg = NetworkConfig {socksProxy = Nothing, tcpTimeout = 5000000}
+      netCfg = defaultNetworkConfig
    }

 logCfg :: LogConfig
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 3.1.0
+version: 3.2.0
 synopsis: SimpleXMQ message broker
 description: |
  This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack

 name:           simplexmq
-version:        3.1.0
+version:        3.2.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                <./docs/Simplex-Messaging-Client.html client> and
@@ -50,6 +50,7 @@ library
      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
      Simplex.Messaging.Client
      Simplex.Messaging.Client.Agent
      Simplex.Messaging.Crypto
@@ -91,7 +91,6 @@ import qualified Data.Text as T
 import Data.Time.Clock
 import Data.Time.Clock.System (systemToUTCTime)
 import qualified Database.SQLite.Simple as DB
-- import GHC.Conc (unsafeIOToSTM)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.NtfSubSupervisor
@@ -119,6 +118,8 @@ import UnliftIO.Concurrent (forkFinally, forkIO, threadDelay)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM

+-- import GHC.Conc (unsafeIOToSTM)
+
 -- | Creates an SMP agent client instance
 getSMPAgentClient :: (MonadRandom m, MonadUnliftIO m) => AgentConfig -> InitialAgentServers -> m AgentClient
 getSMPAgentClient cfg initServers = newSMPAgentEnv cfg >>= runReaderT runAgent
@@ -213,9 +214,9 @@ setNetworkConfig :: AgentErrorMonad m => AgentClient -> NetworkConfig -> m ()
 setNetworkConfig c cfg' = do
  cfg <- atomically $ do
    swapTVar (useNetworkConfig c) cfg'
-  liftIO . when (socksProxy cfg /= socksProxy cfg') $ do
-    closeProtocolServerClients c smpCfg smpClients
-    closeProtocolServerClients c ntfCfg ntfClients
+  liftIO . when (cfg /= cfg') $ do
+    closeProtocolServerClients c smpClients
+    closeProtocolServerClients c ntfClients

 getNetworkConfig :: AgentErrorMonad m => AgentClient -> m NetworkConfig
 getNetworkConfig = readTVarIO . useNetworkConfig
@@ -297,10 +298,11 @@ processCommand c (connId, cmd) = case cmd of
 newConn :: AgentMonad m => AgentClient -> ConnId -> SConnectionMode c -> m (ConnId, ConnectionRequestUri c)
 newConn c connId cMode = do
  srv <- getSMPServer c
-  (rq, qUri) <- newRcvQueue c srv
+  clientVRange <- asks $ smpClientVRange . config
+  (rq, qUri) <- newRcvQueue c srv clientVRange
  g <- asks idsDrg
-  agentVersion <- asks $ smpAgentVersion . config
-  let cData = ConnData {connId, connAgentVersion = agentVersion, duplexHandshake = Nothing} -- connection mode is determined by the accepting agent
+  connAgentVersion <- asks $ maxVersion . smpAgentVRange . config
+  let cData = ConnData {connId, connAgentVersion, duplexHandshake = Nothing} -- connection mode is determined by the accepting agent
  connId' <- withStore c $ \db -> createRcvConn db g cData rq cMode
  addSubscription c rq connId'
  ns <- asks ntfSupervisor
@@ -317,7 +319,8 @@ newConn c connId cMode = do
 joinConn :: AgentMonad m => AgentClient -> ConnId -> ConnectionRequestUri c -> ConnInfo -> m ConnId
 joinConn c connId (CRInvitationUri (ConnReqUriData _ agentVRange (qUri :| _)) e2eRcvParamsUri) cInfo = do
  aVRange <- asks $ smpAgentVRange . config
-  case ( qUri `compatibleVersion` SMP.smpClientVRange,
+  clientVRange <- asks $ smpClientVRange . config
+  case ( qUri `compatibleVersion` clientVRange,
         e2eRcvParamsUri `compatibleVersion` CR.e2eEncryptVRange,
         agentVRange `compatibleVersion` aVRange
       ) of
@@ -345,7 +348,8 @@ joinConn c connId (CRInvitationUri (ConnReqUriData _ agentVRange (qUri :| _)) e2
    _ -> throwError $ AGENT A_VERSION
 joinConn c connId (CRContactUri (ConnReqUriData _ agentVRange (qUri :| _))) cInfo = do
  aVRange <- asks $ smpAgentVRange . config
-  case ( qUri `compatibleVersion` SMP.smpClientVRange,
+  clientVRange <- asks $ smpClientVRange . config
+  case ( qUri `compatibleVersion` clientVRange,
         agentVRange `compatibleVersion` aVRange
       ) of
    (Just qInfo, Just vrsn) -> do
@@ -354,12 +358,11 @@ joinConn c connId (CRContactUri (ConnReqUriData _ agentVRange (qUri :| _))) cInf
      pure connId'
    _ -> throwError $ AGENT A_VERSION

-createReplyQueue :: AgentMonad m => AgentClient -> ConnId -> m SMPQueueInfo
-createReplyQueue c connId = do
+createReplyQueue :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> m SMPQueueInfo
+createReplyQueue c connId SndQueue {smpClientVersion} = do
  srv <- getSMPServer c
-  (rq, qUri) <- newRcvQueue c srv
-  -- TODO reply queue version should be the same as send queue, ignoring it in v1
-  let qInfo = toVersionT qUri SMP.smpClientVersion
+  (rq, qUri) <- newRcvQueue c srv $ versionToRange smpClientVersion
+  let qInfo = toVersionT qUri smpClientVersion
  addSubscription c rq connId
  withStore c $ \db -> upgradeSndConnToDuplex db connId rq
  ns <- asks ntfSupervisor
@@ -395,9 +398,9 @@ rejectContact' c contactConnId invId =
  withStore c $ \db -> deleteInvitation db contactConnId invId

 processConfirmation :: AgentMonad m => AgentClient -> RcvQueue -> SMPConfirmation -> m ()
-processConfirmation c rq@RcvQueue {e2ePrivKey} SMPConfirmation {senderKey, e2ePubKey} = do
+processConfirmation c rq@RcvQueue {e2ePrivKey, smpClientVersion = v} SMPConfirmation {senderKey, e2ePubKey, smpClientVersion = v'} = do
  let dhSecret = C.dh' e2ePubKey e2ePrivKey
-  withStore' c $ \db -> setRcvQueueConfirmedE2E db rq dhSecret
+  withStore' c $ \db -> setRcvQueueConfirmedE2E db rq dhSecret $ min v v'
  secureQueue c rq senderKey
  withStore' c $ \db -> setRcvQueueStatus db rq Secured

@@ -455,7 +458,7 @@ subscribeConnections' c connIds = do
    addRcvQueue :: Map SMPServer (Map ConnId (RcvQueue, ConnData)) -> ConnId -> (RcvQueue, ConnData) -> Map SMPServer (Map ConnId (RcvQueue, ConnData))
    addRcvQueue m connId rq@(RcvQueue {server}, _) = M.alter (Just . maybe (M.singleton connId rq) (M.insert connId rq)) server m
    subscribe :: (SMPServer, Map ConnId (RcvQueue, ConnData)) -> m (Map ConnId (Either AgentErrorType ()))
-    subscribe (srv, qs) = subscribeQueues c srv (M.map fst qs)
+    subscribe (srv, qs) = snd <$> subscribeQueues c srv (M.map fst qs)
    sendNtfCreate :: NtfSupervisor -> [Map ConnId (Either AgentErrorType ())] -> m ()
    sendNtfCreate ns rcvRs =
      forM_ (concatMap M.assocs rcvRs) $ \case
@@ -590,7 +593,7 @@ getPendingMsgQ c connId SndQueue {server, sndId} = do
 runSmpQueueMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnData -> SndQueue -> m ()
 runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {connId, duplexHandshake} sq = do
  mq <- atomically $ getPendingMsgQ c connId sq
-  ri <- asks $ reconnectInterval . config
+  ri <- asks $ messageRetryInterval . config
  forever $ do
    atomically $ endAgentOperation c AOSndNetwork
    msgId <- atomically $ readTQueue mq
@@ -621,12 +624,8 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {connId, duplexHandsh
                    -- in duplexHandshake mode (v2) HELLO is only sent once, without retrying,
                    -- because the queue must be secured by the time the confirmation or the first HELLO is received
                    | duplexHandshake == Just True -> connErr
-                    | otherwise -> do
-                      helloTimeout <- asks $ helloTimeout . config
-                      currentTime <- liftIO getCurrentTime
-                      if diffUTCTime currentTime internalTs > helloTimeout
-                        then connErr
-                        else retrySending loop
+                    | otherwise ->
+                      ifM (msgExpired helloTimeout) connErr (retrySending loop)
                    where
                      connErr = case rq_ of
                        -- party initiating connection
@@ -635,10 +634,18 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {connId, duplexHandsh
                        _ -> connError msgId NOT_ACCEPTED
                  AM_REPLY_ -> notifyDel msgId $ ERR e
                  AM_A_MSG_ -> notifyDel msgId $ MERR mId e
-                SMP (SMP.CMD _) -> notifyDel msgId err
-                SMP SMP.LARGE_MSG -> notifyDel msgId err
-                SMP {} -> notify err >> retrySending loop
-                _ -> retrySending loop
+                _
+                  -- for other operations BROKER HOST is treated as a permanent error (e.g., when connecting to the server),
+                  -- the message sending would be retried
+                  | temporaryAgentError e || e == BROKER HOST -> do
+                    let timeoutSel = if msgType == AM_HELLO_ then helloTimeout else messageTimeout
+                    ifM (msgExpired timeoutSel) (notifyDel msgId err) (retrySending loop)
+                  | otherwise -> notifyDel msgId err
+              where
+                msgExpired timeoutSel = do
+                  msgTimeout <- asks $ timeoutSel . config
+                  currentTime <- liftIO getCurrentTime
+                  pure $ diffUTCTime currentTime internalTs > msgTimeout
            Right () -> do
              case msgType of
                AM_CONN_INFO -> do
@@ -666,7 +673,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {connId, duplexHandsh
                    -- and this branch should never be reached as receive is created before the confirmation,
                    -- so the condition is not necessary here, strictly speaking.
                    _ -> unless (duplexHandshake == Just True) $ do
-                      qInfo <- createReplyQueue c connId
+                      qInfo <- createReplyQueue c connId sq
                      void . enqueueMessage c cData sq SMP.noMsgFlags $ REPLY [qInfo]
                AM_A_MSG_ -> notify $ SENT mId
                _ -> pure ()
@@ -974,13 +981,14 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, v, sessId, rId, cm
          SMP.ClientRcvMsgBody {msgTs = srvTs, msgFlags, msgBody} <- decryptSMPMessage v rq msg
          clientMsg@SMP.ClientMsgEnvelope {cmHeader = SMP.PubHeader phVer e2ePubKey_} <-
            parseMessage msgBody
-          unless (phVer `isCompatible` SMP.smpClientVRange) . throwError $ AGENT A_VERSION
+          clientVRange <- asks $ smpClientVRange . config
+          unless (phVer `isCompatible` clientVRange) . throwError $ AGENT A_VERSION
          case (e2eDhSecret, e2ePubKey_) of
            (Nothing, Just e2ePubKey) -> do
              let e2eDh = C.dh' e2ePubKey e2ePrivKey
              decryptClientMessage e2eDh clientMsg >>= \case
                (SMP.PHConfirmation senderKey, AgentConfirmation {e2eEncryption, encConnInfo, agentVersion}) ->
-                  smpConfirmation senderKey e2ePubKey e2eEncryption encConnInfo agentVersion >> ack
+                  smpConfirmation senderKey e2ePubKey e2eEncryption encConnInfo phVer agentVersion >> ack
                (SMP.PHEmpty, AgentInvitation {connReq, connInfo}) ->
                  smpInvitation connReq connInfo >> ack
                _ -> prohibited >> ack
@@ -1077,11 +1085,13 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, v, sessId, rId, cm
        parseMessage :: Encoding a => ByteString -> m a
        parseMessage = liftEither . parse smpP (AGENT A_MESSAGE)

-        smpConfirmation :: C.APublicVerifyKey -> C.PublicKeyX25519 -> Maybe (CR.E2ERatchetParams 'C.X448) -> ByteString -> Version -> m ()
-        smpConfirmation senderKey e2ePubKey e2eEncryption encConnInfo agentVersion = do
+        smpConfirmation :: C.APublicVerifyKey -> C.PublicKeyX25519 -> Maybe (CR.E2ERatchetParams 'C.X448) -> ByteString -> Version -> Version -> m ()
+        smpConfirmation senderKey e2ePubKey e2eEncryption encConnInfo smpClientVersion agentVersion = do
          logServer "<--" c srv rId "MSG <CONF>"
-          aVRange <- asks $ smpAgentVRange . config
-          unless (agentVersion `isCompatible` aVRange) . throwError $ AGENT A_VERSION
+          AgentConfig {smpAgentVRange, smpClientVRange} <- asks config
+          unless
+            (agentVersion `isCompatible` smpAgentVRange && smpClientVersion `isCompatible` smpClientVRange)
+            (throwError $ AGENT A_VERSION)
          case status of
            New -> case (conn, e2eEncryption) of
              -- party initiating connection
@@ -1093,9 +1103,9 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, v, sessId, rId, cm
                  (Right agentMsgBody, CR.SMDNoChange) ->
                    parseMessage agentMsgBody >>= \case
                      AgentConnInfo connInfo ->
-                        processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = []} False
+                        processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = [], smpClientVersion} False
                      AgentConnInfoReply smpQueues connInfo ->
-                        processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues} True
+                        processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion} True
                      _ -> prohibited
                    where
                      processConf connInfo senderConf duplexHS = do
@@ -1104,15 +1114,16 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, v, sessId, rId, cm
                        confId <- withStore c $ \db -> do
                          setHandshakeVersion db connId agentVersion duplexHS
                          createConfirmation db g newConfirmation
-                        let srvs = map (\SMPQueueInfo {smpServer = s} -> s) $ smpReplyQueues senderConf
+                        let srvs = map queueServer $ smpReplyQueues senderConf
                        notify $ CONF confId srvs connInfo
+                      queueServer (SMPQueueInfo _ SMPQueueAddress {smpServer}) = smpServer
                  _ -> prohibited
              -- party accepting connection
              (DuplexConnection _ _ sq, Nothing) -> do
                withStore c (\db -> runExceptT $ agentRatchetDecrypt db connId encConnInfo) >>= parseMessage >>= \case
                  AgentConnInfo connInfo -> do
                    notify $ INFO connInfo
-                    processConfirmation c rq $ SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = []}
+                    processConfirmation c rq $ SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = [], smpClientVersion}
                    when (duplexHandshake == Just True) $ enqueueDuplexHello sq
                  _ -> prohibited
              _ -> prohibited
@@ -1158,9 +1169,11 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, v, sessId, rId, cm
              g <- asks idsDrg
              let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo}
              invId <- withStore c $ \db -> createInvitation db g newInv
-              let srvs = L.map (\SMPQueueUri {smpServer = s} -> s) $ crSmpQueues crData
+              let srvs = L.map queueServer $ crSmpQueues crData
              notify $ REQ invId srvs cInfo
            _ -> prohibited
+          where
+            queueServer (SMPQueueUri _ SMPQueueAddress {smpServer}) = smpServer

        checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> ByteString -> MsgIntegrity
        checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash receivedPrevMsgHash
@@ -1173,8 +1186,8 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, v, sessId, rId, cm

 connectReplyQueues :: AgentMonad m => AgentClient -> ConnData -> ConnInfo -> L.NonEmpty SMPQueueInfo -> m ()
 connectReplyQueues c cData@ConnData {connId} ownConnInfo (qInfo :| _) = do
-  -- TODO make this proof on receiving confirmation too
-  case qInfo `proveCompatible` SMP.smpClientVRange of
+  clientVRange <- asks $ smpClientVRange . config
+  case qInfo `proveCompatible` clientVRange of
    Nothing -> throwError $ AGENT A_VERSION
    Just qInfo' -> do
      sq <- newSndQueue qInfo'
@@ -1196,7 +1209,7 @@ confirmQueue (Compatible agentVersion) c connId sq connInfo e2eEncryption = do
    mkAgentMessage :: Version -> m AgentMessage
    mkAgentMessage 1 = pure $ AgentConnInfo connInfo
    mkAgentMessage _ = do
-      qInfo <- createReplyQueue c connId
+      qInfo <- createReplyQueue c connId sq
      pure $ AgentConnInfoReply (qInfo :| []) connInfo

 enqueueConfirmation :: forall m. AgentMonad m => AgentClient -> ConnData -> SndQueue -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
@@ -1246,7 +1259,7 @@ newSndQueue_ ::
  C.SAlgorithm a ->
  Compatible SMPQueueInfo ->
  m SndQueue
-newSndQueue_ a (Compatible (SMPQueueInfo _clientVersion smpServer senderId rcvE2ePubDhKey)) = do
+newSndQueue_ a (Compatible (SMPQueueInfo smpClientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey = rcvE2ePubDhKey})) = do
  -- this function assumes clientVersion is compatible - it was tested before
  (sndPublicKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
  (e2ePubKey, e2ePrivKey) <- liftIO C.generateKeyPair'
@@ -1258,5 +1271,6 @@ newSndQueue_ a (Compatible (SMPQueueInfo _clientVersion smpServer senderId rcvE2
        sndPrivateKey,
        e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
        e2ePubKey = Just e2ePubKey,
-        status = New
+        status = New,
+        smpClientVersion
      }
@@ -29,7 +29,7 @@ module Simplex.Messaging.Agent.Client
    getSubscriptions,
    sendConfirmation,
    sendInvitation,
-    RetryInterval (..),
+    temporaryAgentError,
    secureQueue,
    enableQueueNotifications,
    disableQueueNotifications,
@@ -101,14 +101,36 @@ import Simplex.Messaging.Client
 import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Client
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
-import Simplex.Messaging.Protocol (BrokerMsg, ErrorType, MsgFlags (..), MsgId, NotifierId, NtfPrivateSignKey, NtfPublicVerifyKey, NtfServer, ProtoServer, ProtocolServer (..), QueueId, QueueIdsKeys (..), RcvMessage (..), RcvNtfPublicDhKey, SMPMsgMeta (..), SndPublicVerifyKey)
+import Simplex.Messaging.Protocol
+  ( AProtocolType (..),
+    BrokerMsg,
+    ErrorType,
+    MsgFlags (..),
+    MsgId,
+    NotifierId,
+    NtfPrivateSignKey,
+    NtfPublicVerifyKey,
+    NtfServer,
+    ProtoServer,
+    Protocol (..),
+    ProtocolServer (..),
+    ProtocolTypeI (..),
+    QueueId,
+    QueueIdsKeys (..),
+    RcvMessage (..),
+    RcvNtfPublicDhKey,
+    SMPMsgMeta (..),
+    SndPublicVerifyKey,
+  )
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Timeout (timeout)
@@ -223,7 +245,7 @@ getSMPServerClient c@AgentClient {active, smpClients, msgQ} srv = do
  atomically (getClientVar srv smpClients)
    >>= either
      (newProtocolClient c srv smpClients connectClient reconnectClient)
-      (waitForProtocolClient smpCfg)
+      (waitForProtocolClient c)
  where
    connectClient :: m SMPClient
    connectClient = do
@@ -231,46 +253,47 @@ getSMPServerClient c@AgentClient {active, smpClients, msgQ} srv = do
      u <- askUnliftIO
      liftEitherError (protocolClientError SMP) (getProtocolClient srv cfg (Just msgQ) $ clientDisconnected u)

-    clientDisconnected :: UnliftIO m -> IO ()
-    clientDisconnected u = do
-      removeClientAndSubs >>= (`forM_` serverDown u)
+    clientDisconnected :: UnliftIO m -> SMPClient -> IO ()
+    clientDisconnected u client = do
+      removeClientAndSubs >>= (`forM_` serverDown)
      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
-
-    removeClientAndSubs :: IO (Maybe (Map ConnId RcvQueue))
-    removeClientAndSubs = atomically $ do
-      TM.delete srv smpClients
-      TM.lookupDelete srv (subscrSrvrs c) >>= mapM updateSubs
      where
-        updateSubs cVar = do
-          cs <- readTVar cVar
-          modifyTVar' (subscrConns c) (`M.withoutKeys` M.keysSet cs)
-          addPendingSubs cVar cs
-          pure cs
+        removeClientAndSubs :: IO (Maybe (Map ConnId RcvQueue))
+        removeClientAndSubs = atomically $ do
+          TM.delete srv smpClients
+          TM.lookupDelete srv (subscrSrvrs c) >>= mapM updateSubs
+          where
+            updateSubs cVar = do
+              cs <- readTVar cVar
+              modifyTVar' (subscrConns c) (`M.withoutKeys` M.keysSet cs)
+              addPendingSubs cVar cs
+              pure cs

-        addPendingSubs cVar cs = do
-          let ps = pendingSubscrSrvrs c
-          TM.lookup srv ps >>= \case
-            Just v -> TM.union cs v
-            _ -> TM.insert srv cVar ps
+            addPendingSubs cVar cs = do
+              let ps = pendingSubscrSrvrs c
+              TM.lookup srv ps >>= \case
+                Just v -> TM.union cs v
+                _ -> TM.insert srv cVar ps

-    serverDown :: UnliftIO m -> Map ConnId RcvQueue -> IO ()
-    serverDown u cs = unless (M.null cs) $
-      whenM (readTVarIO active) $ do
-        let conns = M.keys cs
-        unless (null conns) . notifySub "" $ DOWN srv conns
-        atomically $ mapM_ (releaseGetLock c) cs
-        unliftIO u reconnectServer
+        serverDown :: Map ConnId RcvQueue -> IO ()
+        serverDown cs = unless (M.null cs) $
+          whenM (readTVarIO active) $ do
+            let conns = M.keys cs
+            notifySub "" $ hostEvent DISCONNECT client
+            unless (null conns) . notifySub "" $ DOWN srv conns
+            atomically $ mapM_ (releaseGetLock c) cs
+            unliftIO u reconnectServer

-    reconnectServer :: m ()
-    reconnectServer = do
-      a <- async tryReconnectClient
-      atomically $ modifyTVar' (reconnections c) (a :)
+        reconnectServer :: m ()
+        reconnectServer = do
+          a <- async tryReconnectClient
+          atomically $ modifyTVar' (reconnections c) (a :)

-    tryReconnectClient :: m ()
-    tryReconnectClient = do
-      ri <- asks $ reconnectInterval . config
-      withRetryInterval ri $ \loop ->
-        reconnectClient `catchError` const loop
+        tryReconnectClient :: m ()
+        tryReconnectClient = do
+          ri <- asks $ reconnectInterval . config
+          withRetryInterval ri $ \loop ->
+            reconnectClient `catchError` const loop

    reconnectClient :: m ()
    reconnectClient =
@@ -280,8 +303,11 @@ getSMPServerClient c@AgentClient {active, smpClients, msgQ} srv = do
      where
        resubscribe :: Map ConnId RcvQueue -> m ()
        resubscribe qs = do
-          (errs, oks) <- M.mapEither id <$> subscribeQueues c srv qs
-          liftIO . unless (M.null oks) . notifySub "" . UP srv $ M.keys oks
+          (client_, (errs, oks)) <- second (M.mapEither id) <$> subscribeQueues c srv qs
+          liftIO $ do
+            mapM_ (notifySub "" . hostEvent CONNECT) client_
+            unless (M.null oks) $ do
+              notifySub "" . UP srv $ M.keys oks
          let (tempErrs, finalErrs) = M.partition temporaryAgentError errs
          liftIO . mapM_ (\(connId, e) -> notifySub connId $ ERR e) $ M.assocs finalErrs
          mapM_ throwError . listToMaybe $ M.elems tempErrs
@@ -295,16 +321,17 @@ getNtfServerClient c@AgentClient {active, ntfClients} srv = do
  atomically (getClientVar srv ntfClients)
    >>= either
      (newProtocolClient c srv ntfClients connectClient $ pure ())
-      (waitForProtocolClient ntfCfg)
+      (waitForProtocolClient c)
  where
    connectClient :: m NtfClient
    connectClient = do
      cfg <- atomically . updateClientConfig c =<< asks (ntfCfg . config)
      liftEitherError (protocolClientError NTF) (getProtocolClient srv cfg Nothing clientDisconnected)

-    clientDisconnected :: IO ()
-    clientDisconnected = do
+    clientDisconnected :: NtfClient -> IO ()
+    clientDisconnected client = do
      atomically $ TM.delete srv ntfClients
+      atomically $ writeTBQueue (subQ c) ("", "", hostEvent DISCONNECT client)
      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv

 getClientVar :: forall a s. ProtocolServer s -> TMap (ProtocolServer s) (TMVar a) -> STM (Either (TMVar a) (TMVar a))
@@ -316,10 +343,10 @@ getClientVar srv clients = maybe (Left <$> newClientVar) (pure . Right) =<< TM.l
      TM.insert srv var clients
      pure var

-waitForProtocolClient :: AgentMonad m => (AgentConfig -> ProtocolClientConfig) -> ClientVar msg -> m (ProtocolClient msg)
-waitForProtocolClient clientConfig clientVar = do
-  ProtocolClientConfig {tcpTimeout} <- asks $ clientConfig . config
-  client_ <- liftIO $ tcpTimeout `timeout` atomically (readTMVar clientVar)
+waitForProtocolClient :: AgentMonad m => AgentClient -> ClientVar msg -> m (ProtocolClient msg)
+waitForProtocolClient c clientVar = do
+  NetworkConfig {tcpConnectTimeout} <- readTVarIO $ useNetworkConfig c
+  client_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar clientVar)
  liftEither $ case client_ of
    Just (Right smpClient) -> Right smpClient
    Just (Left e) -> Left e
@@ -327,7 +354,7 @@ waitForProtocolClient clientConfig clientVar = do

 newProtocolClient ::
  forall msg m.
-  AgentMonad m =>
+  (AgentMonad m, ProtocolTypeI (ProtoType msg)) =>
  AgentClient ->
  ProtoServer msg ->
  TMap (ProtoServer msg) (ClientVar msg) ->
@@ -343,6 +370,7 @@ newProtocolClient c srv clients connectClient reconnectClient clientVar = tryCon
        Right client -> do
          logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
          atomically $ putTMVar clientVar r
+          atomically $ writeTBQueue (subQ c) ("", "", hostEvent CONNECT client)
          successAction client
        Left e -> do
          if temporaryAgentError e
@@ -360,16 +388,19 @@ newProtocolClient c srv clients connectClient reconnectClient clientVar = tryCon
      ri <- asks $ reconnectInterval . config
      withRetryInterval ri $ \loop -> void $ tryConnectClient (const reconnectClient) loop

+hostEvent :: forall msg. ProtocolTypeI (ProtoType msg) => (AProtocolType -> TransportHost -> ACommand 'Agent) -> ProtocolClient msg -> ACommand 'Agent
+hostEvent event client = event (AProtocolType $ protocolTypeI @(ProtoType msg)) $ transportHost client
+
 updateClientConfig :: AgentClient -> ProtocolClientConfig -> STM ProtocolClientConfig
 updateClientConfig AgentClient {useNetworkConfig} cfg = do
-  NetworkConfig {socksProxy, tcpTimeout} <- readTVar useNetworkConfig
-  pure (cfg :: ProtocolClientConfig) {socksProxy, tcpTimeout}
+  networkConfig <- readTVar useNetworkConfig
+  pure cfg {networkConfig}

 closeAgentClient :: MonadIO m => AgentClient -> m ()
 closeAgentClient c = liftIO $ do
  atomically $ writeTVar (active c) False
-  closeProtocolServerClients c smpCfg smpClients
-  closeProtocolServerClients c ntfCfg ntfClients
+  closeProtocolServerClients c smpClients
+  closeProtocolServerClients c ntfClients
  cancelActions $ reconnections c
  cancelActions $ asyncClients c
  cancelActions $ smpQueueMsgDeliveries c
@@ -383,14 +414,14 @@ closeAgentClient c = liftIO $ do
    clear :: (AgentClient -> TMap k a) -> IO ()
    clear sel = atomically $ writeTVar (sel c) M.empty

-closeProtocolServerClients :: AgentClient -> (AgentConfig -> ProtocolClientConfig) -> (AgentClient -> TMap (ProtoServer msg) (ClientVar msg)) -> IO ()
-closeProtocolServerClients c cfgSel clientsSel =
+closeProtocolServerClients :: AgentClient -> (AgentClient -> TMap (ProtoServer msg) (ClientVar msg)) -> IO ()
+closeProtocolServerClients c clientsSel =
  readTVarIO cs >>= mapM_ (forkIO . closeClient) >> atomically (writeTVar cs M.empty)
  where
    cs = clientsSel c
-    ProtocolClientConfig {tcpTimeout} = cfgSel . config $ agentEnv c
-    closeClient cVar =
-      tcpTimeout `timeout` atomically (readTMVar cVar) >>= \case
+    closeClient cVar = do
+      NetworkConfig {tcpConnectTimeout} <- readTVarIO $ useNetworkConfig c
+      tcpConnectTimeout `timeout` atomically (readTMVar cVar) >>= \case
        Just (Right client) -> closeProtocolClient client `catchAll_` pure ()
        _ -> pure ()

@@ -434,22 +465,24 @@ protocolClientError protocolError_ = \case
  PCEUnexpectedResponse _ -> BROKER UNEXPECTED
  PCEResponseTimeout -> BROKER TIMEOUT
  PCENetworkError -> BROKER NETWORK
+  PCEIncompatibleHost -> BROKER HOST
  PCETransportError e -> BROKER $ TRANSPORT e
  e@PCESignatureError {} -> INTERNAL $ show e
  e@PCEIOError {} -> INTERNAL $ show e

-newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueUri)
-newRcvQueue c srv =
+newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> VersionRange -> m (RcvQueue, SMPQueueUri)
+newRcvQueue c srv vRange =
  asks (cmdSignAlg . config) >>= \case
-    C.SignAlg a -> newRcvQueue_ a c srv
+    C.SignAlg a -> newRcvQueue_ a c srv vRange

 newRcvQueue_ ::
  (C.SignatureAlgorithm a, C.AlgorithmI a, AgentMonad m) =>
  C.SAlgorithm a ->
  AgentClient ->
  SMPServer ->
+  VersionRange ->
  m (RcvQueue, SMPQueueUri)
-newRcvQueue_ a c srv = do
+newRcvQueue_ a c srv vRange = do
  (recipientKey, rcvPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
  (dhKey, privDhKey) <- liftIO C.generateKeyPair'
  (e2eDhKey, e2ePrivKey) <- liftIO C.generateKeyPair'
@@ -467,9 +500,10 @@ newRcvQueue_ a c srv = do
            e2eDhSecret = Nothing,
            sndId = Just sndId,
            status = New,
+            smpClientVersion = maxVersion vRange,
            clientNtfCreds = Nothing
          }
-  pure (rq, SMPQueueUri srv sndId SMP.smpClientVRange e2eDhKey)
+  pure (rq, SMPQueueUri vRange $ SMPQueueAddress srv sndId e2eDhKey)

 subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m ()
 subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do
@@ -501,14 +535,14 @@ temporaryAgentError = \case
  _ -> False

 -- | subscribe multiple queues - all passed queues should be on the same server
-subscribeQueues :: AgentMonad m => AgentClient -> SMPServer -> Map ConnId RcvQueue -> m (Map ConnId (Either AgentErrorType ()))
+subscribeQueues :: AgentMonad m => AgentClient -> SMPServer -> Map ConnId RcvQueue -> m (Maybe SMPClient, Map ConnId (Either AgentErrorType ()))
 subscribeQueues c srv qs = do
  (errs, qs_) <- partitionEithers <$> mapM checkQueue (M.assocs qs)
  forM_ qs_ $ atomically . uncurry (addPendingSubscription c) . swap
  case L.nonEmpty qs_ of
    Just qs' -> do
      smp_ <- tryError (getSMPServerClient c srv)
-      M.fromList . (errs <>) <$> case smp_ of
+      (eitherToMaybe smp_,) . M.fromList . (errs <>) <$> case smp_ of
        Left e -> pure $ map (second . const $ Left e) qs_
        Right smp -> do
          logServer "-->" c srv (bshow (length qs_) <> " queues") "SUB"
@@ -517,7 +551,7 @@ subscribeQueues c srv qs = do
            liftIO $ zip qs_ . L.toList <$> subscribeSMPQueues smp qs2
          forM_ rs' $ \((connId, rq), r) -> liftIO $ processSubResult c rq connId r
          pure $ map (bimap fst (first $ protocolClientError SMP)) rs'
-    _ -> pure $ M.fromList errs
+    _ -> pure $ (Nothing, M.fromList errs)
  where
    checkQueue rq@(connId, RcvQueue {rcvId, server}) = do
      prohibited <- atomically . TM.member (server, rcvId) $ getMsgLocks c
@@ -565,7 +599,7 @@ logServer dir AgentClient {clientId} srv qId cmdStr =

 showServer :: ProtocolServer s -> ByteString
 showServer ProtocolServer {host, port} =
-  B.pack $ host <> if null port then "" else ':' : port
+  strEncode host <> B.pack (if null port then "" else ':' : port)

 logSecret :: ByteString -> ByteString
 logSecret bs = encode $ B.take 3 bs
@@ -579,7 +613,7 @@ sendConfirmation c sq@SndQueue {server, sndId, sndPublicKey = Just sndPublicKey,
 sendConfirmation _ _ _ = throwError $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"

 sendInvitation :: forall m. AgentMonad m => AgentClient -> Compatible SMPQueueInfo -> Compatible Version -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> m ()
-sendInvitation c (Compatible SMPQueueInfo {smpServer, senderId, dhPublicKey}) (Compatible agentVersion) connReq connInfo =
+sendInvitation c (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) connReq connInfo =
  withLogClient_ c smpServer senderId "SEND <INV>" $ \smp -> do
    msg <- mkInvitation
    liftClient SMP $ sendSMPMessage smp Nothing senderId MsgFlags {notification = True} msg
@@ -588,7 +622,7 @@ sendInvitation c (Compatible SMPQueueInfo {smpServer, senderId, dhPublicKey}) (C
    -- this is only encrypted with per-queue E2E, not with double ratchet
    mkInvitation = do
      let agentEnvelope = AgentInvitation {agentVersion, connReq, connInfo}
-      agentCbEncryptOnce dhPublicKey . smpEncode $
+      agentCbEncryptOnce v dhPublicKey . smpEncode $
        SMP.ClientMessage SMP.PHEmpty $ smpEncode agentEnvelope

 getQueueMessage :: AgentMonad m => AgentClient -> RcvQueue -> m (Maybe SMPMsgMeta)
@@ -692,27 +726,25 @@ agentNtfDeleteSubscription c subId NtfToken {ntfServer, ntfPrivKey} =
  withLogClient c ntfServer subId "SDEL" $ \ntf -> ntfDeleteSubscription ntf ntfPrivKey subId

 agentCbEncrypt :: AgentMonad m => SndQueue -> Maybe C.PublicKeyX25519 -> ByteString -> m ByteString
-agentCbEncrypt SndQueue {e2eDhSecret} e2ePubKey msg = do
+agentCbEncrypt SndQueue {e2eDhSecret, smpClientVersion} e2ePubKey msg = do
  cmNonce <- liftIO C.randomCbNonce
  let paddedLen = maybe SMP.e2eEncMessageLength (const SMP.e2eEncConfirmationLength) e2ePubKey
  cmEncBody <-
    liftEither . first cryptoError $
      C.cbEncrypt e2eDhSecret cmNonce msg paddedLen
-  -- TODO per-queue client version
-  let cmHeader = SMP.PubHeader (maxVersion SMP.smpClientVRange) e2ePubKey
+  let cmHeader = SMP.PubHeader smpClientVersion e2ePubKey
  pure $ smpEncode SMP.ClientMsgEnvelope {cmHeader, cmNonce, cmEncBody}

 -- add encoding as AgentInvitation'?
-agentCbEncryptOnce :: AgentMonad m => C.PublicKeyX25519 -> ByteString -> m ByteString
-agentCbEncryptOnce dhRcvPubKey msg = do
+agentCbEncryptOnce :: AgentMonad m => Version -> C.PublicKeyX25519 -> ByteString -> m ByteString
+agentCbEncryptOnce clientVersion dhRcvPubKey msg = do
  (dhSndPubKey, dhSndPrivKey) <- liftIO C.generateKeyPair'
  let e2eDhSecret = C.dh' dhRcvPubKey dhSndPrivKey
  cmNonce <- liftIO C.randomCbNonce
  cmEncBody <-
    liftEither . first cryptoError $
      C.cbEncrypt e2eDhSecret cmNonce msg SMP.e2eEncConfirmationLength
-  -- TODO per-queue client version
-  let cmHeader = SMP.PubHeader (maxVersion SMP.smpClientVRange) (Just dhSndPubKey)
+  let cmHeader = SMP.PubHeader clientVersion (Just dhSndPubKey)
  pure $ smpEncode SMP.ClientMsgEnvelope {cmHeader, cmNonce, cmEncBody}

 -- | NaCl crypto-box decrypt - both for messages received from the server
@@ -1,7 +1,5 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -29,12 +27,9 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Crypto.Random
-import Data.Aeson (FromJSON (..), ToJSON (..))
-import qualified Data.Aeson as J
 import Data.List.NonEmpty (NonEmpty)
 import Data.Time.Clock (NominalDiffTime, nominalDay)
 import Data.Word (Word16)
-import GHC.Generics (Generic)
 import Network.Socket
 import Numeric.Natural
 import Simplex.Messaging.Agent.Protocol
@@ -45,11 +40,11 @@ import Simplex.Messaging.Client
 import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Types
-import Simplex.Messaging.Protocol (NtfServer)
+import Simplex.Messaging.Protocol (NtfServer, supportedSMPClientVRange)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (TLS, Transport (..))
-import Simplex.Messaging.Transport.Client (SocksProxy, defaultSMPPort)
+import Simplex.Messaging.Transport.Client (defaultSMPPort)
 import Simplex.Messaging.Version
 import System.Random (StdGen, newStdGen)
 import UnliftIO (Async)
@@ -64,16 +59,6 @@ data InitialAgentServers = InitialAgentServers
    netCfg :: NetworkConfig
  }

-data NetworkConfig = NetworkConfig
-  { socksProxy :: Maybe SocksProxy,
-    tcpTimeout :: Int
-  }
-  deriving (Show, Generic, FromJSON)
-
-instance ToJSON NetworkConfig where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
 data AgentConfig = AgentConfig
  { tcpPort :: ServiceName,
    cmdSignAlg :: C.SignAlg,
@@ -84,6 +69,8 @@ data AgentConfig = AgentConfig
    smpCfg :: ProtocolClientConfig,
    ntfCfg :: ProtocolClientConfig,
    reconnectInterval :: RetryInterval,
+    messageRetryInterval :: RetryInterval,
+    messageTimeout :: NominalDiffTime,
    helloTimeout :: NominalDiffTime,
    ntfCron :: Word16,
    ntfWorkerDelay :: Int,
@@ -93,19 +80,25 @@ data AgentConfig = AgentConfig
    caCertificateFile :: FilePath,
    privateKeyFile :: FilePath,
    certificateFile :: FilePath,
-    smpAgentVersion :: Version,
-    smpAgentVRange :: VersionRange
+    smpAgentVRange :: VersionRange,
+    smpClientVRange :: VersionRange
  }

 defaultReconnectInterval :: RetryInterval
 defaultReconnectInterval =
  RetryInterval
-    { initialInterval = second,
-      increaseAfter = 10 * second,
-      maxInterval = 10 * second
+    { initialInterval = 2_000000,
+      increaseAfter = 10_000000,
+      maxInterval = 180_000000
+    }
+
+defaultMessageRetryInterval :: RetryInterval
+defaultMessageRetryInterval =
+  RetryInterval
+    { initialInterval = 1_000000,
+      increaseAfter = 10_000000,
+      maxInterval = 60_000000
    }
-  where
-    second = 1_000_000

 defaultAgentConfig :: AgentConfig
 defaultAgentConfig =
@@ -119,6 +112,8 @@ defaultAgentConfig =
      smpCfg = defaultClientConfig {defaultTransport = (show defaultSMPPort, transport @TLS)},
      ntfCfg = defaultClientConfig {defaultTransport = ("443", transport @TLS)},
      reconnectInterval = defaultReconnectInterval,
+      messageRetryInterval = defaultMessageRetryInterval,
+      messageTimeout = 2 * nominalDay,
      helloTimeout = 2 * nominalDay,
      ntfCron = 20, -- minutes
      ntfWorkerDelay = 100000, -- microseconds
@@ -130,8 +125,8 @@ defaultAgentConfig =
      caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
      privateKeyFile = "/etc/opt/simplex-agent/agent.key",
      certificateFile = "/etc/opt/simplex-agent/agent.crt",
-      smpAgentVersion = currentSMPAgentVersion,
-      smpAgentVRange = supportedSMPAgentVRange
+      smpAgentVRange = supportedSMPAgentVRange,
+      smpClientVRange = supportedSMPClientVRange
    }

 data Env = Env
@@ -6,6 +6,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
@@ -32,7 +33,6 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md
 module Simplex.Messaging.Agent.Protocol
  ( -- * Protocol parameters
-    currentSMPAgentVersion,
    supportedSMPAgentVRange,
    e2eEncConnInfoLength,
    e2eEncUserMsgLength,
@@ -40,6 +40,7 @@ module Simplex.Messaging.Agent.Protocol
    -- * SMP agent protocol types
    ConnInfo,
    ACommand (..),
+    ACmd (..),
    AParty (..),
    SAParty (..),
    MsgHash,
@@ -56,6 +57,7 @@ module Simplex.Messaging.Agent.Protocol
    SrvLoc (..),
    SMPQueueUri (..),
    SMPQueueInfo (..),
+    SMPQueueAddress (..),
    ConnectionMode (..),
    SConnectionMode (..),
    AConnectionMode (..),
@@ -95,6 +97,8 @@ module Simplex.Messaging.Agent.Protocol
    serializeQueueStatus,
    queueStatusT,
    agentMessageType,
+    extraSMPServerHosts,
+    updateSMPServerHosts,

    -- * TCP transport functions
    tPut,
@@ -117,7 +121,10 @@ import Data.Composition ((.:), (.:.))
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Kind (Type)
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
+import Data.Map (Map)
+import qualified Data.Map as M
 import Data.Maybe (isJust)
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
@@ -136,18 +143,24 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol
-  ( ErrorType,
+  ( AProtocolType,
+    ErrorType,
    MsgBody,
    MsgFlags,
    MsgId,
    NMsgMeta,
+    ProtocolServer (..),
    SMPServer,
    SndPublicVerifyKey,
    SrvLoc (..),
+    legacyEncodeServer,
+    legacyServerP,
+    legacyStrEncodeServer,
    pattern SMPServer,
  )
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport (Transport (..), TransportError, serializeTransportError, transportErrorP)
+import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts_ (..))
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import Test.QuickCheck (Arbitrary (..))
@@ -218,6 +231,8 @@ data ACommand (p :: AParty) where
  CON :: ACommand Agent -- notification that connection is established
  SUB :: ACommand Client
  END :: ACommand Agent
+  CONNECT :: AProtocolType -> TransportHost -> ACommand Agent
+  DISCONNECT :: AProtocolType -> TransportHost -> ACommand Agent
  DOWN :: SMPServer -> [ConnId] -> ACommand Agent
  UP :: SMPServer -> [ConnId] -> ACommand Agent
  SEND :: MsgFlags -> MsgBody -> ACommand Client
@@ -344,7 +359,9 @@ data SMPConfirmation = SMPConfirmation
    -- | sender's information to be associated with the connection, e.g. sender's profile information
    connInfo :: ConnInfo,
    -- | optional reply queues included in confirmation (added in agent protocol v2)
-    smpReplyQueues :: [SMPQueueInfo]
+    smpReplyQueues :: [SMPQueueInfo],
+    -- | SMP client version
+    smpClientVersion :: Version
  }
  deriving (Show)

@@ -572,20 +589,36 @@ type ConfirmationId = ByteString

 type InvitationId = ByteString

-data SMPQueueInfo = SMPQueueInfo
-  { clientVersion :: Version,
-    smpServer :: SMPServer,
-    senderId :: SMP.SenderId,
-    dhPublicKey :: C.PublicKeyX25519
-  }
+extraSMPServerHosts :: Map TransportHost TransportHost
+extraSMPServerHosts =
+  M.fromList
+    [ ("smp4.simplex.im", "o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion"),
+      ("smp5.simplex.im", "jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion"),
+      ("smp6.simplex.im", "bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"),
+      ("smp8.simplex.im", "beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion"),
+      ("smp9.simplex.im", "jssqzccmrcws6bhmn77vgmhfjmhwlyr3u7puw4erkyoosywgl67slqqd.onion"),
+      ("smp10.simplex.im", "rb2pbttocvnbrngnwziclp2f4ckjq65kebafws6g4hy22cdaiv5dwjqd.onion")
+    ]
+
+updateSMPServerHosts :: SMPServer -> SMPServer
+updateSMPServerHosts srv@ProtocolServer {host} = case host of
+  h :| [] -> case M.lookup h extraSMPServerHosts of
+    Just h' -> srv {host = [h, h']}
+    _ -> srv
+  _ -> srv
+
+data SMPQueueInfo = SMPQueueInfo {clientVersion :: Version, queueAddress :: SMPQueueAddress}
  deriving (Eq, Show)

 instance Encoding SMPQueueInfo where
-  smpEncode SMPQueueInfo {clientVersion, smpServer, senderId, dhPublicKey} =
-    smpEncode (clientVersion, smpServer, senderId, dhPublicKey)
+  smpEncode (SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey})
+    | clientVersion > 1 = smpEncode (clientVersion, smpServer, senderId, dhPublicKey)
+    | otherwise = smpEncode clientVersion <> legacyEncodeServer smpServer <> smpEncode (senderId, dhPublicKey)
  smpP = do
-    (clientVersion, smpServer, senderId, dhPublicKey) <- smpP
-    pure SMPQueueInfo {clientVersion, smpServer, senderId, dhPublicKey}
+    clientVersion <- smpP
+    smpServer <- if clientVersion > 1 then smpP else updateSMPServerHosts <$> legacyServerP
+    (senderId, dhPublicKey) <- smpP
+    pure $ SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey}

 -- This instance seems contrived and there was a temptation to split a common part of both types.
 -- But this is created to allow backward and forward compatibility where SMPQueueUri
@@ -594,43 +627,51 @@ instance Encoding SMPQueueInfo where
 instance VersionI SMPQueueInfo where
  type VersionRangeT SMPQueueInfo = SMPQueueUri
  version = clientVersion
-  toVersionRangeT SMPQueueInfo {smpServer, senderId, dhPublicKey} vr =
-    SMPQueueUri {clientVRange = vr, smpServer, senderId, dhPublicKey}
+  toVersionRangeT (SMPQueueInfo _v addr) vr = SMPQueueUri vr addr

 instance VersionRangeI SMPQueueUri where
  type VersionT SMPQueueUri = SMPQueueInfo
  versionRange = clientVRange
-  toVersionT SMPQueueUri {smpServer, senderId, dhPublicKey} v =
-    SMPQueueInfo {clientVersion = v, smpServer, senderId, dhPublicKey}
+  toVersionT (SMPQueueUri _vr addr) v = SMPQueueInfo v addr

 -- | SMP queue information sent out-of-band.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#out-of-band-messages
-data SMPQueueUri = SMPQueueUri
+data SMPQueueUri = SMPQueueUri {clientVRange :: VersionRange, queueAddress :: SMPQueueAddress}
+  deriving (Eq, Show)
+
+data SMPQueueAddress = SMPQueueAddress
  { smpServer :: SMPServer,
    senderId :: SMP.SenderId,
-    clientVRange :: VersionRange,
    dhPublicKey :: C.PublicKeyX25519
  }
  deriving (Eq, Show)

 instance StrEncoding SMPQueueUri where
-  -- v1 uses short SMP queue URI format
-  strEncode SMPQueueUri {smpServer = srv, senderId = qId, clientVRange = _vr, dhPublicKey = k} =
-    strEncode srv <> "/" <> strEncode qId <> "#" <> strEncode k
-  strP = do
-    smpServer <- strP <* A.char '/'
-    senderId <- strP <* optional (A.char '/') <* A.char '#'
-    (vr, dhPublicKey) <- unversioned <|> versioned
-    pure SMPQueueUri {smpServer, senderId, clientVRange = vr, dhPublicKey}
+  strEncode (SMPQueueUri vr SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey})
+    | minVersion vr > 1 = strEncode srv <> "/" <> strEncode qId <> "#/?" <> query queryParams
+    | otherwise = legacyStrEncodeServer srv <> "/" <> strEncode qId <> "#/?" <> query (queryParams <> srvParam)
    where
-      unversioned = (SMP.smpClientVRange,) <$> strP <* A.endOfInput
+      query = strEncode . QSP QEscape
+      queryParams = [("v", strEncode vr), ("dh", strEncode dhPublicKey)]
+      srvParam = [("srv", strEncode $ TransportHosts_ hs) | length hs > 0]
+      hs = L.tail $ host srv
+  strP = do
+    srv@ProtocolServer {host = h :| host} <- strP <* A.char '/'
+    senderId <- strP <* optional (A.char '/') <* A.char '#'
+    (vr, hs, dhPublicKey) <- unversioned <|> versioned
+    let srv' = srv {host = h :| host <> hs}
+        smpServer = if maxVersion vr == 1 then updateSMPServerHosts srv' else srv'
+    pure $ SMPQueueUri vr SMPQueueAddress {smpServer, senderId, dhPublicKey}
+    where
+      unversioned = (versionToRange 1,[],) <$> strP <* A.endOfInput
      versioned = do
        dhKey_ <- optional strP
        query <- optional (A.char '/') *> A.char '?' *> strP
        vr <- queryParam "v" query
        dhKey <- maybe (queryParam "dh" query) pure dhKey_
-        pure (vr, dhKey)
+        hs_ <- queryParam_ "srv" query
+        pure (vr, maybe [] thList_ hs_, dhKey)

 data ConnectionRequestUri (m :: ConnectionMode) where
  CRInvitationUri :: ConnReqUriData -> E2ERatchetParamsUri 'C.X448 -> ConnectionRequestUri CMInvitation
@@ -816,6 +857,8 @@ data BrokerErrorType
    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
@@ -891,8 +934,10 @@ commandP =
    <|> "INFO " *> infoCmd
    <|> "SUB" $> ACmd SClient SUB
    <|> "END" $> ACmd SAgent END
-    <|> "DOWN " *> downsResp
-    <|> "UP " *> upsResp
+    <|> "CONNECT " *> connectResp
+    <|> "DISCONNECT " *> disconnectResp
+    <|> "DOWN " *> downResp
+    <|> "UP " *> upResp
    <|> "SEND " *> sendCmd
    <|> "MID " *> msgIdResp
    <|> "SENT " *> sentResp
@@ -916,8 +961,10 @@ commandP =
    acptCmd = ACmd SClient .: ACPT <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString
    rjctCmd = ACmd SClient . RJCT <$> A.takeByteString
    infoCmd = ACmd SAgent . INFO <$> A.takeByteString
-    downsResp = ACmd SAgent .: DOWN <$> strP_ <*> connections
-    upsResp = ACmd SAgent .: UP <$> strP_ <*> connections
+    connectResp = ACmd SAgent .: CONNECT <$> strP_ <*> strP
+    disconnectResp = ACmd SAgent .: DISCONNECT <$> strP_ <*> strP
+    downResp = ACmd SAgent .: DOWN <$> strP_ <*> connections
+    upResp = ACmd SAgent .: UP <$> strP_ <*> connections
    sendCmd = ACmd SClient .: SEND <$> smpP <* A.space <*> A.takeByteString
    msgIdResp = ACmd SAgent . MID <$> A.decimal
    sentResp = ACmd SAgent . SENT <$> A.decimal
@@ -952,6 +999,8 @@ serializeCommand = \case
  INFO cInfo -> "INFO " <> serializeBinary cInfo
  SUB -> "SUB"
  END -> "END"
+  CONNECT p h -> B.unwords ["CONNECT", strEncode p, strEncode h]
+  DISCONNECT p h -> B.unwords ["DISCONNECT", strEncode p, strEncode h]
  DOWN srv conns -> B.unwords ["DOWN", strEncode srv, connections conns]
  UP srv conns -> B.unwords ["UP", strEncode srv, connections conns]
  SEND msgFlags msgBody -> "SEND " <> smpEncode msgFlags <> " " <> serializeBinary msgBody
@@ -1024,6 +1073,8 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
      ACPT {} -> Right cmd
      -- ERROR response does not always have connId
      ERR _ -> Right cmd
+      CONNECT {} -> Right cmd
+      DISCONNECT {} -> Right cmd
      DOWN {} -> Right cmd
      UP {} -> Right cmd
      -- other responses must have connId
@@ -28,3 +28,9 @@ queryParam name (QSP _ q) =
  case find ((== name) . fst) q of
    Just (_, p) -> either fail pure $ parseAll strP p
    _ -> fail $ "no qs param " <> B.unpack name
+
+queryParam_ :: StrEncoding a => ByteString -> QueryStringParams -> Parser (Maybe a)
+queryParam_ name (QSP _ q) =
+  case find ((== name) . fst) q of
+    Just (_, p) -> either fail pure $ parseAll strP p
+    _ -> pure Nothing
@@ -52,6 +52,8 @@ data RcvQueue = RcvQueue
    sndId :: Maybe SMP.SenderId,
    -- | queue status
    status :: QueueStatus,
+    -- | SMP client version
+    smpClientVersion :: Version,
    -- | credentials used in context of notifications
    clientNtfCreds :: Maybe ClientNtfCreds
  }
@@ -81,7 +83,9 @@ data SndQueue = SndQueue
    -- | shared DH secret agreed for simple per-queue e2e encryption
    e2eDhSecret :: C.DhSecretX25519,
    -- | queue status
-    status :: QueueStatus
+    status :: QueueStatus,
+    -- | SMP client version
+    smpClientVersion :: Version
  }
  deriving (Eq, Show)

@@ -104,6 +104,7 @@ import qualified Data.ByteString.Base64.URL as U
 import Data.Char (toLower)
 import Data.Functor (($>))
 import Data.List (find, foldl')
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, listToMaybe)
 import Data.Text (Text)
@@ -127,8 +128,9 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..))
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (blobFieldParser, fromTextField_)
-import Simplex.Messaging.Protocol (MsgBody, MsgFlags, NtfServer, ProtocolServer (..), RcvNtfDhSecret, pattern NtfServer)
+import Simplex.Messaging.Protocol (MsgBody, MsgFlags, NtfServer, ProtocolServer (..), RcvNtfDhSecret, SndPublicVerifyKey, pattern NtfServer)
 import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util (bshow, eitherToMaybe, ($>>=), (<$$>))
 import Simplex.Messaging.Version
 import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
@@ -319,18 +321,20 @@ setRcvQueueStatus db RcvQueue {rcvId, server = ProtocolServer {host, port}} stat
    |]
    [":status" := status, ":host" := host, ":port" := port, ":rcv_id" := rcvId]

-setRcvQueueConfirmedE2E :: DB.Connection -> RcvQueue -> C.DhSecretX25519 -> IO ()
-setRcvQueueConfirmedE2E db RcvQueue {rcvId, server = ProtocolServer {host, port}} e2eDhSecret =
+setRcvQueueConfirmedE2E :: DB.Connection -> RcvQueue -> C.DhSecretX25519 -> Version -> IO ()
+setRcvQueueConfirmedE2E db RcvQueue {rcvId, server = ProtocolServer {host, port}} e2eDhSecret smpClientVersion =
  DB.executeNamed
    db
    [sql|
      UPDATE rcv_queues
      SET e2e_dh_secret = :e2e_dh_secret,
-          status = :status
+          status = :status,
+          smp_client_version = :smp_client_version
      WHERE host = :host AND port = :port AND rcv_id = :rcv_id
    |]
    [ ":status" := Confirmed,
      ":e2e_dh_secret" := e2eDhSecret,
+      ":smp_client_version" := smpClientVersion,
      ":host" := host,
      ":port" := port,
      ":rcv_id" := rcvId
@@ -367,16 +371,28 @@ setRcvQueueNtfCreds db connId clientNtfCreds =
      Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret} -> (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret)
      Nothing -> (Nothing, Nothing, Nothing, Nothing)

+type SMPConfirmationRow = (SndPublicVerifyKey, C.PublicKeyX25519, ConnInfo, Maybe [SMPQueueInfo], Maybe Version)
+
+smpConfirmation :: SMPConfirmationRow -> SMPConfirmation
+smpConfirmation (senderKey, e2ePubKey, connInfo, smpReplyQueues_, smpClientVersion_) =
+  SMPConfirmation
+    { senderKey,
+      e2ePubKey,
+      connInfo,
+      smpReplyQueues = fromMaybe [] smpReplyQueues_,
+      smpClientVersion = fromMaybe 1 smpClientVersion_
+    }
+
 createConfirmation :: DB.Connection -> TVar ChaChaDRG -> NewConfirmation -> IO (Either StoreError ConfirmationId)
-createConfirmation db gVar NewConfirmation {connId, senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues}, ratchetState} =
+createConfirmation db gVar NewConfirmation {connId, senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues, smpClientVersion}, ratchetState} =
  createWithRandomId gVar $ \confirmationId ->
    DB.execute
      db
      [sql|
        INSERT INTO conn_confirmations
-        (confirmation_id, conn_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info, smp_reply_queues, accepted) VALUES (?, ?, ?, ?, ?, ?, ?, 0);
+        (confirmation_id, conn_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info, smp_reply_queues, smp_client_version, accepted) VALUES (?, ?, ?, ?, ?, ?, ?, ?, 0);
      |]
-      (confirmationId, connId, senderKey, e2ePubKey, ratchetState, connInfo, smpReplyQueues)
+      (confirmationId, connId, senderKey, e2ePubKey, ratchetState, connInfo, smpReplyQueues, smpClientVersion)

 acceptConfirmation :: DB.Connection -> ConfirmationId -> ConnInfo -> IO (Either StoreError AcceptedConfirmation)
 acceptConfirmation db confirmationId ownConnInfo = do
@@ -395,17 +411,17 @@ acceptConfirmation db confirmationId ownConnInfo = do
    DB.query
      db
      [sql|
-        SELECT conn_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info, smp_reply_queues
+        SELECT conn_id, ratchet_state, sender_key, e2e_snd_pub_key, sender_conn_info, smp_reply_queues, smp_client_version
        FROM conn_confirmations
        WHERE confirmation_id = ?;
      |]
      (Only confirmationId)
  where
-    confirmation (connId, senderKey, e2ePubKey, ratchetState, connInfo, smpReplyQueues_) =
+    confirmation ((connId, ratchetState) :. confRow) =
      AcceptedConfirmation
        { confirmationId,
          connId,
-          senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = fromMaybe [] smpReplyQueues_},
+          senderConf = smpConfirmation confRow,
          ratchetState,
          ownConnInfo
        }
@@ -416,17 +432,17 @@ getAcceptedConfirmation db connId =
    DB.query
      db
      [sql|
-        SELECT confirmation_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info, smp_reply_queues, own_conn_info
+        SELECT confirmation_id, ratchet_state, own_conn_info, sender_key, e2e_snd_pub_key, sender_conn_info, smp_reply_queues, smp_client_version
        FROM conn_confirmations
        WHERE conn_id = ? AND accepted = 1;
      |]
      (Only connId)
  where
-    confirmation (confirmationId, senderKey, e2ePubKey, ratchetState, connInfo, smpReplyQueues_, ownConnInfo) =
+    confirmation ((confirmationId, ratchetState, ownConnInfo) :. confRow) =
      AcceptedConfirmation
        { confirmationId,
          connId,
-          senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = fromMaybe [] smpReplyQueues_},
+          senderConf = smpConfirmation confRow,
          ratchetState,
          ownConnInfo
        }
@@ -985,6 +1001,10 @@ instance ToField [SMPQueueInfo] where toField = toField . smpEncodeList

 instance FromField [SMPQueueInfo] where fromField = blobFieldParser smpListP

+instance ToField (NonEmpty TransportHost) where toField = toField . decodeLatin1 . strEncode
+
+instance FromField (NonEmpty TransportHost) where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
 listToEither :: e -> [a] -> Either e a
 listToEither _ (x : _) = Right x
 listToEither e _ = Left e
@@ -1062,9 +1082,9 @@ insertRcvQueue_ dbConn connId RcvQueue {..} = do
    dbConn
    [sql|
      INSERT INTO rcv_queues
-        ( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status) VALUES (?,?,?,?,?,?,?,?,?,?);
+        (host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status, smp_client_version) VALUES (?,?,?,?,?,?,?,?,?,?,?);
    |]
-    (host server, port server, rcvId, connId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status)
+    ((host server, port server, rcvId, connId) :. (rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status, smpClientVersion))

 -- * createSndConn helpers

@@ -1074,9 +1094,9 @@ insertSndQueue_ dbConn connId SndQueue {..} = do
    dbConn
    [sql|
      INSERT INTO snd_queues
-        (host, port, snd_id, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret, status) VALUES (?,?,?,?,?, ?,?, ?,?);
+        (host, port, snd_id, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret, status, smp_client_version) VALUES (?,?,?,?,?,?,?,?,?,?);
    |]
-    (host server, port server, sndId, connId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status)
+    (host server, port server, sndId, connId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, smpClientVersion)

 -- * getConn helpers

@@ -1109,7 +1129,7 @@ getRcvQueueByConnId_ dbConn connId =
      dbConn
      [sql|
        SELECT s.key_hash, q.host, q.port, q.rcv_id, q.rcv_private_key, q.rcv_dh_secret,
-          q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.status,
+          q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.status, q.smp_client_version,
          q.ntf_public_key, q.ntf_private_key, q.ntf_id, q.rcv_ntf_dh_secret
        FROM rcv_queues q
        INNER JOIN servers s ON q.host = s.host AND q.port = s.port
@@ -1117,12 +1137,13 @@ getRcvQueueByConnId_ dbConn connId =
      |]
      (Only connId)
  where
-    rcvQueue ((keyHash, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status) :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)) =
+    rcvQueue ((keyHash, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status, smpClientVersion_) :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)) =
      let server = SMPServer host port keyHash
+          smpClientVersion = fromMaybe 1 smpClientVersion_
          clientNtfCreds = case (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_) of
            (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret) -> Just $ ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
            _ -> Nothing
-       in RcvQueue {server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status, clientNtfCreds}
+       in RcvQueue {server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status, smpClientVersion, clientNtfCreds}

 getSndQueueByConnId_ :: DB.Connection -> ConnId -> IO (Maybe SndQueue)
 getSndQueueByConnId_ dbConn connId =
@@ -1130,16 +1151,16 @@ getSndQueueByConnId_ dbConn connId =
    <$> DB.query
      dbConn
      [sql|
-        SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_public_key, q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status
+        SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_public_key, q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status, q.smp_client_version
        FROM snd_queues q
        INNER JOIN servers s ON q.host = s.host AND q.port = s.port
        WHERE q.conn_id = ?;
      |]
      (Only connId)
  where
-    sndQueue [(keyHash, host, port, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status)] =
+    sndQueue [(keyHash, host, port, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, smpClientVersion)] =
      let server = SMPServer host port keyHash
-       in Just SndQueue {server, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status}
+       in Just SndQueue {server, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, smpClientVersion}
    sndQueue _ = Nothing

 -- * updateRcvIds helpers
@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -17,18 +18,25 @@ where

 import Control.Monad (forM_)
 import Data.List (intercalate, sortBy)
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.Map as M
 import Data.Ord (comparing)
 import Data.Text (Text)
+import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (getCurrentTime)
 import Database.SQLite.Simple (Connection, Only (..), Query (..))
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import qualified Database.SQLite3 as SQLite3
+import Simplex.Messaging.Agent.Protocol (extraSMPServerHosts)
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Transport.Client (TransportHost)

 data Migration = Migration {name :: String, up :: Text}
  deriving (Show)
@@ -39,7 +47,8 @@ schemaMigrations =
    ("20220301_snd_queue_keys", m20220301_snd_queue_keys),
    ("20220322_notifications", m20220322_notifications),
    ("20220607_v2", m20220608_v2),
-    ("m20220625_v2_ntf_mode", m20220625_v2_ntf_mode)
+    ("m20220625_v2_ntf_mode", m20220625_v2_ntf_mode),
+    ("m20220811_onion_hosts", m20220811_onion_hosts)
  ]

 -- | The list of migrations in ascending order by date
@@ -55,10 +64,15 @@ get conn migrations =

 run :: Connection -> [Migration] -> IO ()
 run conn ms = DB.withImmediateTransaction conn . forM_ ms $
-  \Migration {name, up} -> insert name >> execSQL up
+  \Migration {name, up} -> insert name >> execSQL up >> updateServers name
  where
    insert name = DB.execute conn "INSERT INTO migrations (name, ts) VALUES (?, ?);" . (name,) =<< getCurrentTime
    execSQL = SQLite3.exec $ DB.connectionHandle conn
+    updateServers = \case
+      "m20220811_onion_hosts" -> forM_ (M.assocs extraSMPServerHosts) $ \(h, h') ->
+        let hs = decodeLatin1 . strEncode $ ([h, h'] :: NonEmpty TransportHost)
+         in DB.execute conn "UPDATE servers SET host = ? WHERE host = ?" (hs, decodeLatin1 $ strEncode h)
+      _ -> pure ()

 initialize :: Connection -> IO ()
 initialize conn =
@@ -0,0 +1,16 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220811_onion_hosts :: Query
+m20220811_onion_hosts =
+  [sql|
+ALTER TABLE conn_confirmations ADD COLUMN smp_client_version INTEGER;
+
+UPDATE ntf_servers
+SET ntf_host = 'ntf2.simplex.im,ntg7jdjy2i3qbib3sykiho3enekwiaqg3icctliqhtqcg6jmoh6cxiad.onion'
+WHERE ntf_host = 'ntf2.simplex.im';
+|]
@@ -113,7 +113,8 @@ CREATE TABLE conn_confirmations(
  own_conn_info BLOB,
  created_at TEXT NOT NULL DEFAULT(datetime('now'))
  ,
-  smp_reply_queues BLOB NULL
+  smp_reply_queues BLOB NULL,
+  smp_client_version INTEGER
 ) WITHOUT ROWID;
 CREATE TABLE conn_invitations(
  invitation_id BLOB NOT NULL PRIMARY KEY,
@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -25,7 +26,7 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Client
  ( -- * Connect (disconnect) client to (from) SMP server
-    ProtocolClient (thVersion, sessionId),
+    ProtocolClient (thVersion, sessionId, transportHost),
    SMPClient,
    getProtocolClient,
    closeProtocolClient,
@@ -50,7 +51,10 @@ module Simplex.Messaging.Client
    -- * Supporting types and client configuration
    ProtocolClientError (..),
    ProtocolClientConfig (..),
+    NetworkConfig (..),
    defaultClientConfig,
+    defaultNetworkConfig,
+    chooseTransportHost,
    ServerTransmission,
  )
 where
@@ -62,21 +66,26 @@ import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Except
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (rights)
 import Data.Functor (($>))
+import Data.List (find)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
+import GHC.Generics (Generic)
 import Network.Socket (ServiceName)
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Parsers (dropPrefix, enumJSON)
 import Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Transport.Client (SocksProxy, runTransportClient)
+import Simplex.Messaging.Transport.Client (SocksProxy, TransportHost (..), runTransportClient)
 import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, liftError, raceAny_)
@@ -92,6 +101,7 @@ data ProtocolClient msg = ProtocolClient
    sessionId :: SessionId,
    thVersion :: Version,
    protocolServer :: ProtoServer msg,
+    transportHost :: TransportHost,
    tcpTimeout :: Int,
    clientCorrId :: TVar Natural,
    sentCommands :: TMap CorrId (Request msg),
@@ -108,20 +118,65 @@ type ClientCommand msg = (Maybe C.APrivateSignKey, QueueId, ProtoCommand msg)
 -- | Type synonym for transmission from some SPM server queue.
 type ServerTransmission msg = (ProtoServer msg, Version, SessionId, QueueId, msg)

+data HostMode
+  = -- | prefer (or require) onion hosts when connecting via SOCKS proxy
+    HMOnionViaSocks
+  | -- | prefer (or require) onion hosts
+    HMOnion
+  | -- | prefer (or require) public hosts
+    HMPublic
+  deriving (Eq, Show, Generic)
+
+instance FromJSON HostMode where
+  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "HM"
+
+instance ToJSON HostMode where
+  toJSON = J.genericToJSON . enumJSON $ dropPrefix "HM"
+  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "HM"
+
+-- | network configuration for the client
+data NetworkConfig = NetworkConfig
+  { -- | use SOCKS5 proxy
+    socksProxy :: Maybe SocksProxy,
+    -- | 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,
+    -- | timeout for the initial client TCP/TLS connection (microseconds)
+    tcpConnectTimeout :: Int,
+    -- | timeout of protocol commands (microseconds)
+    tcpTimeout :: Int,
+    -- | TCP keep-alive options, Nothing to skip enabling keep-alive
+    tcpKeepAlive :: Maybe KeepAliveOpts,
+    -- | period for SMP ping commands (microseconds)
+    smpPingInterval :: Int
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON NetworkConfig where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
+defaultNetworkConfig :: NetworkConfig
+defaultNetworkConfig =
+  NetworkConfig
+    { socksProxy = Nothing,
+      hostMode = HMOnionViaSocks,
+      requiredHostMode = False,
+      tcpConnectTimeout = 7_500_000,
+      tcpTimeout = 5_000_000,
+      tcpKeepAlive = Just defaultKeepAliveOpts,
+      smpPingInterval = 600_000_000 -- 10min
+    }
+
 -- | protocol client configuration.
 data ProtocolClientConfig = ProtocolClientConfig
  { -- | size of TBQueue to use for server commands and responses
    qSize :: Natural,
    -- | default server port if port is not specified in ProtocolServer
    defaultTransport :: (ServiceName, ATransport),
-    -- | timeout of TCP commands (microseconds)
-    tcpTimeout :: Int,
-    -- | TCP keep-alive options, Nothing to skip enabling keep-alive
-    tcpKeepAlive :: Maybe KeepAliveOpts,
-    -- | use SOCKS5 proxy
-    socksProxy :: Maybe SocksProxy,
-    -- | period for SMP ping commands (microseconds)
-    smpPing :: Int,
+    -- | network configuration
+    networkConfig :: NetworkConfig,
    -- | SMP client-server protocol version range
    smpServerVRange :: VersionRange
  }
@@ -132,10 +187,7 @@ defaultClientConfig =
  ProtocolClientConfig
    { qSize = 64,
      defaultTransport = ("443", transport @TLS),
-      tcpTimeout = 5_000_000,
-      tcpKeepAlive = Just defaultKeepAliveOpts,
-      socksProxy = Nothing,
-      smpPing = 600_000_000, -- 10min
+      networkConfig = defaultNetworkConfig,
      smpServerVRange = supportedSMPServerVRange
    }

@@ -146,18 +198,36 @@ data Request msg = Request

 type Response msg = Either ProtocolClientError msg

+chooseTransportHost :: NetworkConfig -> NonEmpty TransportHost -> Either ProtocolClientError TransportHost
+chooseTransportHost NetworkConfig {socksProxy, hostMode, requiredHostMode} hosts =
+  firstOrError $ case hostMode of
+    HMOnionViaSocks -> maybe publicHost (const onionHost) socksProxy
+    HMOnion -> onionHost
+    HMPublic -> publicHost
+  where
+    firstOrError
+      | requiredHostMode = maybe (Left PCEIncompatibleHost) Right
+      | otherwise = Right . fromMaybe (L.head hosts)
+    isOnionHost = \case THOnionHost _ -> True; _ -> False
+    onionHost = find isOnionHost hosts
+    publicHost = find (not . isOnionHost) hosts
+
 -- | Connects to 'ProtocolServer' using passed client configuration
 -- and queue for messages and notifications.
 --
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
-getProtocolClient :: forall msg. Protocol msg => ProtoServer msg -> ProtocolClientConfig -> Maybe (TBQueue (ServerTransmission msg)) -> IO () -> IO (Either ProtocolClientError (ProtocolClient msg))
-getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tcpKeepAlive, socksProxy, smpPing, smpServerVRange} msgQ disconnected =
-  (atomically mkProtocolClient >>= runClient useTransport)
-    `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
+getProtocolClient :: forall msg. Protocol msg => ProtoServer msg -> ProtocolClientConfig -> Maybe (TBQueue (ServerTransmission msg)) -> (ProtocolClient msg -> IO ()) -> IO (Either ProtocolClientError (ProtocolClient msg))
+getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, networkConfig, smpServerVRange} msgQ disconnected = do
+  case chooseTransportHost networkConfig (host protocolServer) of
+    Right useHost ->
+      (atomically (mkProtocolClient useHost) >>= runClient useTransport useHost)
+        `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
+    Left e -> pure $ Left e
  where
-    mkProtocolClient :: STM (ProtocolClient msg)
-    mkProtocolClient = do
+    NetworkConfig {tcpConnectTimeout, tcpTimeout, tcpKeepAlive, socksProxy, smpPingInterval} = networkConfig
+    mkProtocolClient :: TransportHost -> STM (ProtocolClient msg)
+    mkProtocolClient transportHost = do
      connected <- newTVar False
      clientCorrId <- newTVar 0
      sentCommands <- TM.empty
@@ -170,6 +240,7 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tc
            thVersion = undefined,
            connected,
            protocolServer,
+            transportHost,
            tcpTimeout,
            clientCorrId,
            sentCommands,
@@ -178,14 +249,14 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tc
            msgQ
          }

-    runClient :: (ServiceName, ATransport) -> ProtocolClient msg -> IO (Either ProtocolClientError (ProtocolClient msg))
-    runClient (port', ATransport t) c = do
+    runClient :: (ServiceName, ATransport) -> TransportHost -> ProtocolClient msg -> IO (Either ProtocolClientError (ProtocolClient msg))
+    runClient (port', ATransport t) useHost c = do
      thVar <- newEmptyTMVarIO
      action <-
        async $
-          runTransportClient socksProxy (host protocolServer) port' (Just $ keyHash protocolServer) tcpKeepAlive (client t c thVar)
+          runTransportClient socksProxy useHost port' (Just $ keyHash protocolServer) tcpKeepAlive (client t c thVar)
            `finally` atomically (putTMVar thVar $ Left PCENetworkError)
-      th_ <- tcpTimeout `timeout` atomically (takeTMVar thVar)
+      th_ <- tcpConnectTimeout `timeout` atomically (takeTMVar thVar)
      pure $ case th_ of
        Just (Right THandle {sessionId, thVersion}) -> Right c {action, sessionId, thVersion}
        Just (Left e) -> Left e
@@ -208,7 +279,7 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tc
          let c' = c {sessionId, thVersion} :: ProtocolClient msg
          -- TODO remove ping if 0 is passed (or Nothing?)
          raceAny_ [send c' th, process c', receive c' th, ping c']
-            `finally` disconnected
+            `finally` disconnected c'

    send :: Transport c => ProtocolClient msg -> THandle c -> IO ()
    send ProtocolClient {sndQ} h = forever $ atomically (readTBQueue sndQ) >>= tPut h
@@ -218,7 +289,7 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tc

    ping :: ProtocolClient msg -> IO ()
    ping c = forever $ do
-      threadDelay smpPing
+      threadDelay smpPingInterval
      runExceptT $ sendProtocolCommand c Nothing "" protocolPing

    process :: ProtocolClient msg -> IO ()
@@ -271,6 +342,8 @@ data ProtocolClientError
  | -- | Failure to establish TCP connection.
    -- Forwarded to the agent client as `ERR BROKER NETWORK`.
    PCENetworkError
+  | -- | No host compatible with network configuration
+    PCEIncompatibleHost
  | -- | TCP transport handshake or some other transport error.
    -- Forwarded to the agent client as `ERR BROKER TRANSPORT e`.
    PCETransportError TransportError
@@ -26,6 +26,7 @@ import Numeric.Natural
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BrokerMsg, ProtocolServer (..), QueueId, SMPServer)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -125,8 +126,8 @@ getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, msgQ} srv =

    waitForSMPClient :: SMPClientVar -> ExceptT ProtocolClientError IO SMPClient
    waitForSMPClient smpVar = do
-      let ProtocolClientConfig {tcpTimeout} = smpCfg agentCfg
-      smpClient_ <- liftIO $ tcpTimeout `timeout` atomically (readTMVar smpVar)
+      let ProtocolClientConfig {networkConfig = NetworkConfig {tcpConnectTimeout}} = smpCfg agentCfg
+      smpClient_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar smpVar)
      liftEither $ case smpClient_ of
        Just (Right smpClient) -> Right smpClient
        Just (Left e) -> Left e
@@ -161,8 +162,8 @@ getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, msgQ} srv =
    connectClient :: ExceptT ProtocolClientError IO SMPClient
    connectClient = ExceptT $ getProtocolClient srv (smpCfg agentCfg) (Just msgQ) clientDisconnected

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

@@ -264,7 +265,7 @@ subscribeQueue ca srv sub = do

 showServer :: SMPServer -> ByteString
 showServer ProtocolServer {host, port} =
-  B.pack $ host <> if null port then "" else ':' : port
+  strEncode host <> (B.pack $ if null port then "" else ':' : port)

 smpSubscribe :: SMPClient -> (SMPSub, C.APrivateSignKey) -> ExceptT ProtocolClientError IO ()
 smpSubscribe smp ((party, queueId), privKey) = subscribe_ smp privKey queueId
@@ -23,6 +23,7 @@ import Data.Type.Equality
 import Data.Word (Word16)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
+import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -332,12 +333,16 @@ data SMPQueueNtf = SMPQueueNtf
 instance Encoding SMPQueueNtf where
  smpEncode SMPQueueNtf {smpServer, notifierId} = smpEncode (smpServer, notifierId)
  smpP = do
-    (smpServer, notifierId) <- smpP
-    pure $ SMPQueueNtf {smpServer, notifierId}
+    smpServer <- updateSMPServerHosts <$> smpP
+    notifierId <- smpP
+    pure SMPQueueNtf {smpServer, notifierId}

 instance StrEncoding SMPQueueNtf where
  strEncode SMPQueueNtf {smpServer, notifierId} = strEncode smpServer <> "/" <> strEncode notifierId
-  strP = SMPQueueNtf <$> strP <* A.char '/' <*> strP
+  strP = do
+    smpServer <- updateSMPServerHosts <$> strP
+    notifierId <- A.char '/' *> strP
+    pure SMPQueueNtf {smpServer, notifierId}

 data PushProvider = PPApnsDev | PPApnsProd | PPApnsTest
  deriving (Eq, Ord, Show)
@@ -25,6 +25,7 @@ import Data.Functor (($>))
 import Data.List (intercalate)
 import Data.Map.Strict (Map)
 import qualified Data.Text as T
+import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Clock.System (getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
@@ -212,19 +213,21 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
        atomically (readTBQueue agentQ) >>= \case
          CAConnected _ -> pure ()
          CADisconnected srv subs -> do
-            logInfo . T.pack $ "SMP server disconnected " <> host srv <> " (" <> show (length subs) <> ") subscriptions"
+            logInfo $ "SMP server disconnected " <> showServer' srv <> " (" <> tshow (length subs) <> ") subscriptions"
            forM_ subs $ \(_, ntfId) -> do
              let smpQueue = SMPQueueNtf srv ntfId
              updateSubStatus smpQueue NSInactive
          CAReconnected srv ->
-            logInfo $ "SMP server reconnected " <> T.pack (host srv)
+            logInfo $ "SMP server reconnected " <> showServer' srv
          CAResubscribed srv sub -> do
            let ntfId = snd sub
                smpQueue = SMPQueueNtf srv ntfId
            updateSubStatus smpQueue NSActive
          CASubError srv (_, ntfId) err -> do
-            logError . T.pack $ "SMP subscription error on server " <> host srv <> ": " <> show err
+            logError $ "SMP subscription error on server " <> showServer' srv <> ": " <> tshow err
            handleSubError (SMPQueueNtf srv ntfId) err
+      where
+        showServer' = decodeLatin1 . strEncode . host

    handleSubError :: SMPQueueNtf -> ProtocolClientError -> m ()
    handleSubError smpQueue = \case
@@ -235,6 +238,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
      PCEUnexpectedResponse r -> updateErr "UnexpectedResponse " r
      PCETransportError e -> updateErr "TransportError " e
      PCESignatureError e -> updateErr "SignatureError " e
+      PCEIncompatibleHost -> updateSubStatus smpQueue $ NSErr "IncompatibleHost"
      PCEResponseTimeout -> pure ()
      PCENetworkError -> pure ()
      where
@@ -38,8 +38,7 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Protocol
  ( -- * SMP protocol parameters
-    smpClientVersion,
-    smpClientVRange,
+    supportedSMPClientVRange,
    maxMessageLength,
    e2eEncConfirmationLength,
    e2eEncMessageLength,
@@ -65,6 +64,8 @@ module Simplex.Messaging.Protocol
    PrivHeader (..),
    Protocol (..),
    ProtocolType (..),
+    AProtocolType (..),
+    ProtocolTypeI (..),
    ProtocolServer (..),
    ProtoServer,
    SMPServer,
@@ -111,6 +112,9 @@ module Simplex.Messaging.Protocol
    _smpP,
    encodeRcvMsgBody,
    clientRcvMsgBodyP,
+    legacyEncodeServer,
+    legacyServerP,
+    legacyStrEncodeServer,

    -- * TCP transport functions
    tPut,
@@ -133,7 +137,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.Kind
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
-import Data.Maybe (isNothing)
+import Data.Maybe (isJust, isNothing)
 import Data.String
 import Data.Time.Clock.System (SystemTime (..))
 import Data.Type.Equality
@@ -146,15 +150,16 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts (..))
 import Simplex.Messaging.Util (bshow, (<$?>))
 import Simplex.Messaging.Version
 import Test.QuickCheck (Arbitrary (..))

-smpClientVersion :: Version
-smpClientVersion = 1
+currentSMPClientVersion :: Version
+currentSMPClientVersion = 2

-smpClientVRange :: VersionRange
-smpClientVRange = mkVersionRange 1 smpClientVersion
+supportedSMPClientVRange :: VersionRange
+supportedSMPClientVRange = mkVersionRange 1 currentSMPClientVersion

 maxMessageLength :: Int
 maxMessageLength = 16088
@@ -555,14 +560,14 @@ instance Encoding ClientMessage where

 type SMPServer = ProtocolServer 'PSMP

-pattern SMPServer :: HostName -> ServiceName -> C.KeyHash -> ProtocolServer 'PSMP
+pattern SMPServer :: NonEmpty TransportHost -> ServiceName -> C.KeyHash -> ProtocolServer 'PSMP
 pattern SMPServer host port keyHash = ProtocolServer SPSMP host port keyHash

 {-# COMPLETE SMPServer #-}

 type NtfServer = ProtocolServer 'PNTF

-pattern NtfServer :: HostName -> ServiceName -> C.KeyHash -> ProtocolServer 'PNTF
+pattern NtfServer :: NonEmpty TransportHost -> ServiceName -> C.KeyHash -> ProtocolServer 'PNTF
 pattern NtfServer host port keyHash = ProtocolServer SPNTF host port keyHash

 {-# COMPLETE NtfServer #-}
@@ -575,7 +580,7 @@ instance StrEncoding ProtocolType where
    PSMP -> "smp"
    PNTF -> "ntf"
  strP =
-    A.takeTill (== ':') >>= \case
+    A.takeTill (\c -> c == ':' || c == ' ') >>= \case
      "smp" -> pure PSMP
      "ntf" -> pure PNTF
      _ -> fail "bad ProtocolType"
@@ -592,6 +597,11 @@ deriving instance Show (SProtocolType p)

 data AProtocolType = forall p. ProtocolTypeI p => AProtocolType (SProtocolType p)

+deriving instance Show AProtocolType
+
+instance Eq AProtocolType where
+  AProtocolType p == AProtocolType p' = isJust $ testEquality p p'
+
 instance TestEquality SProtocolType where
  testEquality SPSMP SPSMP = Just Refl
  testEquality SPNTF SPNTF = Just Refl
@@ -615,6 +625,10 @@ instance StrEncoding AProtocolType where
  strEncode (AProtocolType p) = strEncode p
  strP = aProtocolType <$> strP

+instance ToJSON AProtocolType where
+  toEncoding = strToJEncoding
+  toJSON = strToJSON
+
 checkProtocolType :: forall t p p'. (ProtocolTypeI p, ProtocolTypeI p') => t p' -> Either String (t p)
 checkProtocolType p = case testEquality (protocolTypeI @p) (protocolTypeI @p') of
  Just Refl -> Right p
@@ -630,7 +644,7 @@ instance ProtocolTypeI 'PNTF where protocolTypeI = SPNTF
 -- | server location and transport key digest (hash).
 data ProtocolServer p = ProtocolServer
  { scheme :: SProtocolType p,
-    host :: HostName,
+    host :: NonEmpty TransportHost,
    port :: ServiceName,
    keyHash :: C.KeyHash
  }
@@ -648,17 +662,39 @@ instance ProtocolTypeI p => Encoding (ProtocolServer p) where

 instance ProtocolTypeI p => StrEncoding (ProtocolServer p) where
  strEncode ProtocolServer {scheme, host, port, keyHash} =
-    strEncode scheme <> "://" <> strEncode keyHash <> "@" <> strEncode (SrvLoc host port)
+    strEncodeServer scheme (strEncode host) port keyHash
  strP = do
    scheme <- strP <* "://"
    keyHash <- strP <* A.char '@'
-    SrvLoc host port <- strP
+    TransportHosts host <- strP
+    port <- portP <|> pure ""
    pure ProtocolServer {scheme, host, port, keyHash}
+    where
+      portP = show <$> (A.char ':' *> (A.decimal :: Parser Int))

 instance ProtocolTypeI p => ToJSON (ProtocolServer p) where
  toJSON = strToJSON
  toEncoding = strToJEncoding

+legacyEncodeServer :: ProtocolServer p -> ByteString
+legacyEncodeServer ProtocolServer {host, port, keyHash} =
+  smpEncode (L.head host, port, keyHash)
+
+legacyServerP :: forall p. ProtocolTypeI p => Parser (ProtocolServer p)
+legacyServerP = do
+  (h, port, keyHash) <- smpP
+  pure ProtocolServer {scheme = protocolTypeI @p, host = [h], port, keyHash}
+
+legacyStrEncodeServer :: ProtocolTypeI p => ProtocolServer p -> ByteString
+legacyStrEncodeServer ProtocolServer {scheme, host, port, keyHash} =
+  strEncodeServer scheme (strEncode $ L.head host) port keyHash
+
+strEncodeServer :: ProtocolTypeI p => SProtocolType p -> ByteString -> ServiceName -> C.KeyHash -> ByteString
+strEncodeServer scheme host port keyHash =
+  strEncode scheme <> "://" <> strEncode keyHash <> "@" <> host <> portStr
+  where
+    portStr = B.pack $ if null port then "" else ':' : port
+
 data SrvLoc = SrvLoc HostName ServiceName
  deriving (Eq, Ord, Show)

@@ -99,7 +99,7 @@ supportedSMPServerVRange :: VersionRange
 supportedSMPServerVRange = mkVersionRange 1 4

 simplexMQVersion :: String
-simplexMQVersion = "3.1.3"
+simplexMQVersion = "3.2.0"

 -- * Transport connection class

@@ -1,3 +1,6 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}

 module Simplex.Messaging.Transport.Client
@@ -7,6 +10,9 @@ module Simplex.Messaging.Transport.Client
    defaultSMPPort,
    defaultSocksProxy,
    SocksProxy,
+    TransportHost (..),
+    TransportHosts (..),
+    TransportHosts_ (..),
  )
 where

@@ -18,7 +24,11 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Default (def)
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
+import Data.String
+import Data.Word (Word8)
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
 import Data.X509.Validation (Fingerprint (..))
@@ -28,31 +38,81 @@ import Network.Socket
 import Network.Socks5
 import qualified Network.TLS as T
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (parseAll, parseString)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.KeepAlive
+import Simplex.Messaging.Util (bshow, (<$?>))
 import System.IO.Error
 import Text.Read (readMaybe)
 import UnliftIO.Exception (IOException)
 import qualified UnliftIO.Exception as E

+data TransportHost
+  = THIPv4 (Word8, Word8, Word8, Word8)
+  | THOnionHost ByteString
+  | THDomainName HostName
+  deriving (Eq, Ord, Show)
+
+instance Encoding TransportHost where
+  smpEncode = smpEncode . strEncode
+  smpP = parseAll strP <$?> smpP
+
+instance StrEncoding TransportHost where
+  strEncode = \case
+    THIPv4 (a1, a2, a3, a4) -> B.intercalate "." $ map bshow [a1, a2, a3, a4]
+    THOnionHost host -> host
+    THDomainName host -> B.pack host
+  strP =
+    A.choice
+      [ THIPv4 <$> ((,,,) <$> ipNum <*> ipNum <*> ipNum <*> A.decimal),
+        THOnionHost <$> ((<>) <$> A.takeTill (== '.') <*> A.string ".onion"),
+        THDomainName . B.unpack <$> A.takeWhile1 (A.notInClass ":#,;/ ")
+      ]
+    where
+      ipNum = A.decimal <* A.char '.'
+
+instance ToJSON TransportHost where
+  toEncoding = strToJEncoding
+  toJSON = strToJSON
+
+newtype TransportHosts = TransportHosts {thList :: NonEmpty TransportHost}
+
+instance StrEncoding TransportHosts where
+  strEncode = strEncodeList . L.toList . thList
+  strP = TransportHosts . L.fromList <$> strP `A.sepBy1'` A.char ','
+
+newtype TransportHosts_ = TransportHosts_ {thList_ :: [TransportHost]}
+
+instance StrEncoding TransportHosts_ where
+  strEncode = strEncodeList . thList_
+  strP = TransportHosts_ <$> strP `A.sepBy'` A.char ','
+
+instance IsString TransportHost where fromString = parseString strDecode
+
+instance IsString (NonEmpty TransportHost) where fromString = parseString strDecode
+
 -- | Connect to passed TCP host:port and pass handle to the client.
-runTransportClient :: (Transport c, MonadUnliftIO m) => Maybe SocksProxy -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
+runTransportClient :: (Transport c, MonadUnliftIO m) => Maybe SocksProxy -> TransportHost -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
 runTransportClient = runTLSTransportClient supportedParameters Nothing

-runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> Maybe SocksProxy -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
+runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> Maybe SocksProxy -> TransportHost -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
 runTLSTransportClient tlsParams caStore_ socksProxy_ host port keyHash keepAliveOpts client = do
-  let clientParams = mkTLSClientParams tlsParams caStore_ host port keyHash
-      connectTCP = maybe connectTCPClient connectSocksClient socksProxy_
-  c <- liftIO $ connectTLSClient connectTCP host port clientParams keepAliveOpts
+  let clientParams = mkTLSClientParams tlsParams caStore_ (B.unpack $ strEncode host) port keyHash
+      connectTCP = case socksProxy_ of
+        Just proxy -> connectSocksClient proxy $ hostAddr host
+        _ -> connectTCPClient . B.unpack $ strEncode host
+  c <- liftIO $ do
+    sock <- connectTCP port
+    mapM_ (setSocketKeepAlive sock) keepAliveOpts
+    connectTLS clientParams sock >>= getClientConnection
  client c `E.finally` liftIO (closeConnection c)
-
-connectTLSClient :: forall c. Transport c => (HostName -> ServiceName -> IO Socket) -> HostName -> ServiceName -> T.ClientParams -> Maybe KeepAliveOpts -> IO c
-connectTLSClient tcpClient host port clientParams keepAliveOpts = do
-  sock <- tcpClient host port
-  mapM_ (setSocketKeepAlive sock) keepAliveOpts
-  ctx <- connectTLS clientParams sock
-  getClientConnection ctx
+  where
+    hostAddr = \case
+      THIPv4 addr -> SocksAddrIPV4 $ tupleToHostAddress addr
+      THOnionHost h -> SocksAddrDomainName h
+      THDomainName h -> SocksAddrDomainName $ B.pack h

 connectTCPClient :: HostName -> ServiceName -> IO Socket
 connectTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
@@ -79,10 +139,10 @@ connectTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
 defaultSMPPort :: PortNumber
 defaultSMPPort = 5223

-connectSocksClient :: SocksProxy -> HostName -> ServiceName -> IO Socket
-connectSocksClient (SocksProxy addr) host _port = do
+connectSocksClient :: SocksProxy -> SocksHostAddress -> ServiceName -> IO Socket
+connectSocksClient (SocksProxy addr) hostAddr _port = do
  let port = if null _port then defaultSMPPort else fromMaybe defaultSMPPort $ readMaybe _port
-  fst <$> socksConnect (defaultSocksConf addr) (SocksAddress (SocksAddrDomainName $ B.pack host) port)
+  fst <$> socksConnect (defaultSocksConf addr) (SocksAddress hostAddr port)

 defaultSocksHost :: HostAddress
 defaultSocksHost = tupleToHostAddress (127, 0, 0, 1)
@@ -19,7 +19,7 @@ import qualified Network.HTTP2.Client as H
 import Network.Socket (HostName, ServiceName)
 import qualified Network.TLS as T
 import Numeric.Natural (Natural)
-import Simplex.Messaging.Transport.Client (runTLSTransportClient)
+import Simplex.Messaging.Transport.Client (TransportHost (..), runTLSTransportClient)
 import Simplex.Messaging.Transport.HTTP2 (http2TLSParams, withTlsConfig)
 import Simplex.Messaging.Transport.KeepAlive (KeepAliveOpts)
 import UnliftIO.STM
@@ -122,7 +122,7 @@ sendRequest HTTP2Client {reqQ, config} req = do

 runHTTP2Client :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe KeepAliveOpts -> ((Request -> (Response -> IO ()) -> IO ()) -> IO ()) -> IO ()
 runHTTP2Client tlsParams caStore host port keepAliveOpts client =
-  runTLSTransportClient tlsParams caStore Nothing host port Nothing keepAliveOpts $ \c ->
+  runTLSTransportClient tlsParams caStore Nothing (THDomainName host) port Nothing keepAliveOpts $ \c ->
    withTlsConfig c 16384 (`run` client)
  where
    run = H.run $ ClientConfig "https" (B.pack host) 20
@@ -1,10 +1,15 @@
 {-# LANGUAGE CApiFFI #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE NamedFieldPuns #-}

 module Simplex.Messaging.Transport.KeepAlive where

+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as J
 import Foreign.C (CInt (..))
+import GHC.Generics (Generic)
 import Network.Socket

 data KeepAliveOpts = KeepAliveOpts
@@ -12,7 +17,9 @@ data KeepAliveOpts = KeepAliveOpts
    keepIntvl :: Int,
    keepCnt :: Int
  }
-  deriving (Show)
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON KeepAliveOpts where toEncoding = J.genericToEncoding J.defaultOptions

 defaultKeepAliveOpts :: KeepAliveOpts
 defaultKeepAliveOpts =
@@ -15,6 +15,7 @@ module Simplex.Messaging.Version
    pattern Compatible,
    mkVersionRange,
    safeVersionRange,
+    versionToRange,
    isCompatible,
    proveCompatible,
    compatibleVersion,
@@ -53,6 +54,9 @@ safeVersionRange v1 v2
  | v1 <= v2 = Just $ VRange v1 v2
  | otherwise = Nothing

+versionToRange :: Version -> VersionRange
+versionToRange v = VRange v v
+
 instance Encoding VersionRange where
  smpEncode (VRange v1 v2) = smpEncode (v1, v2)
  smpP =
@@ -78,9 +78,17 @@ agentTests (ATransport t) = do
    it "should deliver messages if one of connections has quota exceeded" $
      smpAgentTest2_2_1 $ testMsgDeliveryQuotaExceeded t

+tGetAgent :: Transport c => c -> IO (ATransmissionOrError 'Agent)
+tGetAgent h = do
+  t@(_, _, cmd) <- tGet SAgent h
+  case cmd of
+    Right CONNECT {} -> tGetAgent h
+    Right DISCONNECT {} -> tGetAgent h
+    _ -> pure t
+
 -- | receive message to handle `h`
 (<#:) :: Transport c => c -> IO (ATransmissionOrError 'Agent)
-(<#:) = tGet SAgent
+(<#:) = tGetAgent

 -- | send transmission `t` to handle `h` and get response
 (#:) :: Transport c => c -> (ByteString, ByteString, ByteString) -> IO (ATransmissionOrError 'Agent)
@@ -114,7 +122,7 @@ h <#= p = (h <#:) >>= (`shouldSatisfy` p . correctTransmission)
 h #:# err = tryGet `shouldReturn` ()
  where
    tryGet =
-      10000 `timeout` tGet SAgent h >>= \case
+      10000 `timeout` tGetAgent h >>= \case
        Just _ -> error err
        _ -> return ()

@@ -11,7 +11,7 @@ import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (ProtocolServer (..), smpClientVRange)
+import Simplex.Messaging.Protocol (ProtocolServer (..), supportedSMPClientVRange)
 import Simplex.Messaging.Version
 import Test.Hspec

@@ -21,15 +21,23 @@ uri = "smp.simplex.im"
 srv :: SMPServer
 srv = SMPServer "smp.simplex.im" "5223" (C.KeyHash "\215m\248\251")

-queue :: SMPQueueUri
-queue =
-  SMPQueueUri
+queueAddr :: SMPQueueAddress
+queueAddr =
+  SMPQueueAddress
    { smpServer = srv,
      senderId = "\223\142z\251",
-      clientVRange = smpClientVRange,
      dhPublicKey = testDhKey
    }

+queueAddrNoPort :: SMPQueueAddress
+queueAddrNoPort = queueAddr {smpServer = srv {port = ""}}
+
+queue :: SMPQueueUri
+queue = SMPQueueUri supportedSMPClientVRange queueAddr
+
+queueV1 :: SMPQueueUri
+queueV1 = SMPQueueUri (mkVersionRange 1 1) queueAddr
+
 testDhKey :: C.PublicKeyX25519
 testDhKey = "MCowBQYDK2VuAyEAjiswwI3O/NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="

@@ -44,7 +52,7 @@ connReqData =
  ConnReqUriData
    { crScheme = simplexChat,
      crAgentVRange = mkVersionRange 1 1,
-      crSmpQueues = [queue]
+      crSmpQueues = [queueV1]
    }

 testDhPubKey :: C.PublicKeyX448
@@ -65,40 +73,40 @@ connectionRequest12 :: AConnectionRequestUri
 connectionRequest12 =
  ACR SCMInvitation $
    CRInvitationUri
-      connReqData {crAgentVRange = supportedSMPAgentVRange, crSmpQueues = [queue, queue]}
+      connReqData {crAgentVRange = supportedSMPAgentVRange, crSmpQueues = [queueV1, queueV1]}
      testE2ERatchetParams13

 connectionRequestTests :: Spec
 connectionRequestTests =
  describe "connection request parsing / serializing" $ do
    it "should serialize SMP queue URIs" $ do
-      strEncode (queue :: SMPQueueUri) {smpServer = srv {port = ""}}
-        `shouldBe` "smp://[email protected]/3456-w==#" <> testDhKeyStr
+      strEncode (queue :: SMPQueueUri) {queueAddress = queueAddrNoPort}
+        `shouldBe` "smp://[email protected]/3456-w==#/?v=1-2&dh=" <> testDhKeyStrUri
      strEncode queue {clientVRange = mkVersionRange 1 2}
-        `shouldBe` "smp://[email protected]:5223/3456-w==#" <> testDhKeyStr
+        `shouldBe` "smp://[email protected]:5223/3456-w==#/?v=1-2&dh=" <> testDhKeyStrUri
    it "should parse SMP queue URIs" $ do
-      strDecode ("smp://[email protected]/3456-w==#/?v=1&dh=" <> testDhKeyStr)
-        `shouldBe` Right (queue :: SMPQueueUri) {smpServer = srv {port = ""}}
+      strDecode ("smp://[email protected]/3456-w==#/?v=1-2&dh=" <> testDhKeyStr)
+        `shouldBe` Right (queue :: SMPQueueUri) {queueAddress = queueAddrNoPort}
      strDecode ("smp://[email protected]/3456-w==#" <> testDhKeyStr)
-        `shouldBe` Right (queue :: SMPQueueUri) {smpServer = srv {port = ""}}
+        `shouldBe` Right (queueV1 :: SMPQueueUri) {queueAddress = queueAddrNoPort}
      strDecode ("smp://[email protected]:5223/3456-w==#" <> testDhKeyStr)
-        `shouldBe` Right queue
-      strDecode ("smp://[email protected]:5223/3456-w==#" <> testDhKeyStr <> "/?v=1&extra_param=abc")
-        `shouldBe` Right queue
-      strDecode ("smp://[email protected]:5223/3456-w==#/?extra_param=abc&v=1-2&dh=" <> testDhKeyStr)
-        `shouldBe` Right queue {clientVRange = mkVersionRange 1 2}
+        `shouldBe` Right queueV1
      strDecode ("smp://[email protected]:5223/3456-w==#" <> testDhKeyStr <> "/?v=1-2&extra_param=abc")
-        `shouldBe` Right queue {clientVRange = mkVersionRange 1 2}
+        `shouldBe` Right queue
+      strDecode ("smp://[email protected]:5223/3456-w==#/?extra_param=abc&v=1&dh=" <> testDhKeyStr)
+        `shouldBe` Right queueV1
+      strDecode ("smp://[email protected]:5223/3456-w==#" <> testDhKeyStr <> "/?v=1&extra_param=abc")
+        `shouldBe` Right queueV1
    it "should serialize connection requests" $ do
      strEncode connectionRequest
-        `shouldBe` "https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
-        <> testDhKeyStrUri
+        `shouldBe` "https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
+        <> urlEncode True testDhKeyStrUri
        <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
      strEncode connectionRequest12
-        `shouldBe` "https://simplex.chat/invitation#/?v=1-2&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
-        <> testDhKeyStrUri
-        <> "%2Csmp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
-        <> testDhKeyStrUri
+        `shouldBe` "https://simplex.chat/invitation#/?v=1-2&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
+        <> urlEncode True testDhKeyStrUri
+        <> "%2Csmp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D"
+        <> urlEncode True testDhKeyStrUri
        <> "&e2e=v%3D1-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
    it "should parse connection requests" $ do
      strDecode
@@ -47,7 +47,12 @@ a ##> t = a >>= \t' -> liftIO (t' `shouldBe` t)
 a =##> p = a >>= \t -> liftIO (t `shouldSatisfy` p)

 get :: MonadIO m => AgentClient -> m (ATransmission 'Agent)
-get c = atomically (readTBQueue $ subQ c)
+get c = do
+  t@(_, _, cmd) <- atomically (readTBQueue $ subQ c)
+  case cmd of
+    CONNECT {} -> get c
+    DISCONNECT {} -> get c
+    _ -> pure t

 pattern Msg :: MsgBody -> ACommand 'Agent
 pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} _ msgBody
@@ -56,7 +61,7 @@ smpCfgV1 :: ProtocolClientConfig
 smpCfgV1 = (smpCfg agentCfg) {smpServerVRange = mkVersionRange 1 1}

 agentCfgV1 :: AgentConfig
-agentCfgV1 = agentCfg {smpAgentVersion = 1, smpAgentVRange = mkVersionRange 1 1, smpCfg = smpCfgV1}
+agentCfgV1 = agentCfg {smpAgentVRange = mkVersionRange 1 1, smpClientVRange = mkVersionRange 1 1, smpCfg = smpCfgV1}

 functionalAPITests :: ATransport -> Spec
 functionalAPITests t = do
@@ -161,6 +161,7 @@ rcvQueue1 =
      e2eDhSecret = Nothing,
      sndId = Just "2345",
      status = New,
+      smpClientVersion = 1,
      clientNtfCreds = Nothing
    }

@@ -173,7 +174,8 @@ sndQueue1 =
      sndPrivateKey = testPrivateSignKey,
      e2ePubKey = Nothing,
      e2eDhSecret = testDhSecret,
-      status = New
+      status = New,
+      smpClientVersion = 1
    }

 testCreateRcvConn :: SpecWith SQLiteStore
@@ -305,7 +307,8 @@ testUpgradeRcvConnToDuplex =
              sndPrivateKey = testPrivateSignKey,
              e2ePubKey = Nothing,
              e2eDhSecret = testDhSecret,
-              status = New
+              status = New,
+              smpClientVersion = 1
            }
    upgradeRcvConnToDuplex db "conn1" anotherSndQueue
      `shouldReturn` Left (SEBadConnType CSnd)
@@ -328,6 +331,7 @@ testUpgradeSndConnToDuplex =
              e2eDhSecret = Nothing,
              sndId = Just "4567",
              status = New,
+              smpClientVersion = 1,
              clientNtfCreds = Nothing
            }
    upgradeSndConnToDuplex db "conn1" anotherRcvQueue
@@ -24,12 +24,14 @@ import qualified Data.Aeson as J
 import qualified Data.Aeson.Types as JT
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
+import Data.List.NonEmpty (NonEmpty)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Network.HTTP.Types (Status)
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Server as H
 import Network.Socket
+import Simplex.Messaging.Client (chooseTransportHost, defaultNetworkConfig)
 import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
@@ -51,7 +53,7 @@ import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 import UnliftIO.Timeout (timeout)

-testHost :: HostName
+testHost :: NonEmpty TransportHost
 testHost = "localhost"

 ntfTestPort :: ServiceName
@@ -66,9 +68,10 @@ testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
 ntfTestStoreLogFile :: FilePath
 ntfTestStoreLogFile = "tests/tmp/ntf-server-store.log"

-testNtfClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
-testNtfClient client =
-  runTransportClient Nothing testHost ntfTestPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
+testNtfClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (THandle c -> m a) -> m a
+testNtfClient client = do
+  Right host <- pure $ chooseTransportHost defaultNetworkConfig testHost
+  runTransportClient Nothing host ntfTestPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
    liftIO (runExceptT $ ntfClientHandshake h testKeyHash supportedNTFServerVRange) >>= \case
      Right th -> client th
      Left e -> error $ show e
@@ -133,7 +136,7 @@ withNtfServerOn t port' = withNtfServerThreadOn t port' . const
 withNtfServer :: (MonadUnliftIO m, MonadRandom m) => ATransport -> m a -> m a
 withNtfServer t = withNtfServerOn t ntfTestPort

-runNtfTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => (THandle c -> m a) -> m a
+runNtfTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m, MonadFail m) => (THandle c -> m a) -> m a
 runNtfTest test = withNtfServer (transport @c) $ testNtfClient test

 ntfServerTest ::
@@ -1,4 +1,5 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -9,8 +10,9 @@ module SMPAgentClient where
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import qualified Data.ByteString.Char8 as B
+import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
-import Network.Socket (HostName, ServiceName)
+import Network.Socket (ServiceName)
 import NtfClient (ntfTestPort)
 import SMPClient
  ( serverBracket,
@@ -25,7 +27,8 @@ import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Server (runSMPAgentBlocking)
-import Simplex.Messaging.Client (ProtocolClientConfig (..), defaultClientConfig)
+import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost, defaultClientConfig, defaultNetworkConfig)
+import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.KeepAlive
@@ -33,7 +36,7 @@ import Test.Hspec
 import UnliftIO.Concurrent
 import UnliftIO.Directory

-agentTestHost :: HostName
+agentTestHost :: NonEmpty TransportHost
 agentTestHost = "localhost"

 agentTestPort :: ServiceName
@@ -55,14 +58,21 @@ testDB3 :: String
 testDB3 = "tests/tmp/smp-agent3.test.protocol.db"

 smpAgentTest :: forall c. Transport c => TProxy c -> ARawTransmission -> IO ARawTransmission
-smpAgentTest _ cmd = runSmpAgentTest $ \(h :: c) -> tPutRaw h cmd >> tGetRaw h
+smpAgentTest _ cmd = runSmpAgentTest $ \(h :: c) -> tPutRaw h cmd >> get h
+  where
+    get h = do
+      t@(_, _, cmdStr) <- tGetRaw h
+      case parseAll commandP cmdStr of
+        Right (ACmd SAgent CONNECT {}) -> get h
+        Right (ACmd SAgent DISCONNECT {}) -> get h
+        _ -> pure t

-runSmpAgentTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => (c -> m a) -> m a
+runSmpAgentTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m, MonadFail m) => (c -> m a) -> m a
 runSmpAgentTest test = withSmpServer t . withSmpAgent t $ testSMPAgentClient test
  where
    t = transport @c

-runSmpAgentServerTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => ((ThreadId, ThreadId) -> c -> m a) -> m a
+runSmpAgentServerTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m, MonadFail m) => ((ThreadId, ThreadId) -> c -> m a) -> m a
 runSmpAgentServerTest test =
  withSmpServerThreadOn t testPort $
    \server -> withSmpAgentThreadOn t (agentTestPort, testPort, testDB) $
@@ -73,7 +83,7 @@ runSmpAgentServerTest test =
 smpAgentServerTest :: Transport c => ((ThreadId, ThreadId) -> c -> IO ()) -> Expectation
 smpAgentServerTest test' = runSmpAgentServerTest test' `shouldReturn` ()

-runSmpAgentTestN :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => [(ServiceName, ServiceName, String)] -> ([c] -> m a) -> m a
+runSmpAgentTestN :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m, MonadFail m) => [(ServiceName, ServiceName, String)] -> ([c] -> m a) -> m a
 runSmpAgentTestN agents test = withSmpServer t $ run agents []
  where
    run :: [(ServiceName, ServiceName, String)] -> [c] -> m a
@@ -81,7 +91,7 @@ runSmpAgentTestN agents test = withSmpServer t $ run agents []
    run (a@(p, _, _) : as) hs = withSmpAgentOn t a $ testSMPAgentClientOn p $ \h -> run as (h : hs)
    t = transport @c

-runSmpAgentTestN_1 :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => Int -> ([c] -> m a) -> m a
+runSmpAgentTestN_1 :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m, MonadFail m) => Int -> ([c] -> m a) -> m a
 runSmpAgentTestN_1 nClients test = withSmpServer t . withSmpAgent t $ run nClients []
  where
    run :: Int -> [c] -> m a
@@ -166,7 +176,7 @@ initAgentServers =
  InitialAgentServers
    { smp = L.fromList [testSMPServer],
      ntf = ["ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"],
-      netCfg = NetworkConfig {socksProxy = Nothing, tcpTimeout = 5000000}
+      netCfg = defaultNetworkConfig {tcpTimeout = 500_000}
    }

 initAgentServers2 :: InitialAgentServers
@@ -176,13 +186,13 @@ agentCfg :: AgentConfig
 agentCfg =
  defaultAgentConfig
    { tcpPort = agentTestPort,
-      tbqSize = 1,
+      tbqSize = 4,
      dbFile = testDB,
      smpCfg =
        defaultClientConfig
          { qSize = 1,
            defaultTransport = (testPort, transport @TLS),
-            tcpTimeout = 500_000
+            networkConfig = defaultNetworkConfig {tcpTimeout = 500_000}
          },
      ntfCfg =
        defaultClientConfig
@@ -214,14 +224,15 @@ withSmpAgentOn t (port', smpPort', db') = withSmpAgentThreadOn t (port', smpPort
 withSmpAgent :: (MonadUnliftIO m, MonadRandom m) => ATransport -> m a -> m a
 withSmpAgent t = withSmpAgentOn t (agentTestPort, testPort, testDB)

-testSMPAgentClientOn :: (Transport c, MonadUnliftIO m) => ServiceName -> (c -> m a) -> m a
+testSMPAgentClientOn :: (Transport c, MonadUnliftIO m, MonadFail m) => ServiceName -> (c -> m a) -> m a
 testSMPAgentClientOn port' client = do
-  runTransportClient Nothing agentTestHost port' (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> do
+  Right useHost <- pure $ chooseTransportHost defaultNetworkConfig agentTestHost
+  runTransportClient Nothing useHost port' (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> do
    line <- liftIO $ getLn h
    if line == "Welcome to SMP agent v" <> B.pack simplexMQVersion
      then client h
      else do
        error $ "wrong welcome message: " <> B.unpack line

-testSMPAgentClient :: (Transport c, MonadUnliftIO m) => (c -> m a) -> m a
+testSMPAgentClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (c -> m a) -> m a
 testSMPAgentClient = testSMPAgentClientOn agentTestPort
@@ -14,7 +14,9 @@ import Control.Monad.Except (runExceptT)
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
+import Data.List.NonEmpty (NonEmpty)
 import Network.Socket
+import Simplex.Messaging.Client (chooseTransportHost, defaultNetworkConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol
@@ -30,7 +32,7 @@ import qualified UnliftIO.Exception as E
 import UnliftIO.STM (TMVar, atomically, newEmptyTMVarIO, takeTMVar)
 import UnliftIO.Timeout (timeout)

-testHost :: HostName
+testHost :: NonEmpty TransportHost
 testHost = "localhost"

 testPort :: ServiceName
@@ -54,9 +56,10 @@ testStoreMsgsFile = "tests/tmp/smp-server-messages.log"
 testServerStatsBackupFile :: FilePath
 testServerStatsBackupFile = "tests/tmp/smp-server-stats.log"

-testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
-testSMPClient client =
-  runTransportClient Nothing testHost testPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
+testSMPClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (THandle c -> m a) -> m a
+testSMPClient client = do
+  Right useHost <- pure $ chooseTransportHost defaultNetworkConfig testHost
+  runTransportClient Nothing useHost testPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
    liftIO (runExceptT $ smpClientHandshake h testKeyHash supportedSMPServerVRange) >>= \case
      Right th -> client th
      Left e -> error $ show e
@@ -125,10 +128,10 @@ withSmpServerOn t port' = withSmpServerThreadOn t port' . const
 withSmpServer :: (MonadUnliftIO m, MonadRandom m) => ATransport -> m a -> m a
 withSmpServer t = withSmpServerOn t testPort

-runSmpTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => (THandle c -> m a) -> m a
+runSmpTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m, MonadFail m) => (THandle c -> m a) -> m a
 runSmpTest test = withSmpServer (transport @c) $ testSMPClient test

-runSmpTestN :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => Int -> ([THandle c] -> m a) -> m a
+runSmpTestN :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m, MonadFail m) => Int -> ([THandle c] -> m a) -> m a
 runSmpTestN nClients test = withSmpServer (transport @c) $ run nClients []
  where
    run :: Int -> [THandle c] -> m a
Author	SHA1	Message	Date
Evgeny Poberezkin	180b4b9dcb	version 3.2.0 (#499 )	2022-08-16 20:45:35 +01:00
Evgeny Poberezkin	0437796232	support multiple server hosts with notifications (#498 ) * support multiple server hosts with notifications * remove unused type * remove unused import * update server hosts during parsing	2022-08-14 21:10:34 +01:00
Evgeny Poberezkin	02bba01c16	send host events when server hosts are connected and disconnected (#496 )	2022-08-13 11:57:36 +01:00
Evgeny Poberezkin	68138c08d2	support multiple server hostnames per queue (#494 ) * store SMP client version per queue * use versioned format for queue addresses (not compatible with v1) * multiple server hosts in queue URI/data, versioned encoding (cross-version tests fail) * choose server host based on socksProxy setting * test works * multiple server addresses mostly work * add onion hosts for provided servers * update SMP hosts	2022-08-12 11:32:04 +01:00
Evgeny Poberezkin	6bfaa4985e	expire messages after 2 days, increase max message sending interval (#490 ) * expire messages after 2 days, increase max message sending interval * rename	2022-08-11 10:15:08 +01:00
Evgeny Poberezkin	7d99c4b35c	reconnect agent clients on any network config change (#489 ) * reconnect agent clients on any network config change * add Eq instances	2022-08-03 09:59:49 +01:00
Evgeny Poberezkin	e9db0a1162	allow passing all network configuration to the agent (#488 )	2022-08-02 13:30:00 +01:00