smp-server: add serverInfoBytes to THandleParams and related functions

src/Simplex/FileTransfer/Client.hs

@@ -147,7 +147,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
   let HTTP2Client {sessionId, sessionALPN} = http2Client
       v = VersionXFTP 1
       thServerVRange = versionToRange v
-      thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
+      thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False, serverInfoBytes = Nothing}
   logDebug $ "Client negotiated handshake protocol: " <> tshow sessionALPN
   thParams@THandleParams {thVersion} <- case sessionALPN of
     Just alpn

src/Simplex/FileTransfer/Server.hs

@@ -157,7 +157,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
             reqBody <- getHTTP2Body r xftpBlockSize
             let v = VersionXFTP 1
                 thServerVRange = versionToRange v
-                thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
+                thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False, serverInfoBytes = Nothing}
                 req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse, sniUsed, addCORS = addCORS'}
             flip runReaderT env $ case sessionALPN of
               Nothing -> processRequest req0

src/Simplex/Messaging/Agent.hs

@@ -199,6 +199,7 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.Agent.Store.Interface (closeDBStore, execSQL, getCurrentMigrations)
 import Simplex.Messaging.Agent.Store.Shared (UpMigration (..), upMigration)
+import Simplex.Messaging.Server.Information (ServerPublicInfo)
 import qualified Simplex.Messaging.Agent.TSessionSubs as SS
 import Simplex.Messaging.Client (NetworkRequestMode (..), ProtocolClientError (..), SMPClientError, ServerTransmission (..), ServerTransmissionBatch, TransportSessionMode (..), nonBlockingWriteTBQueue, smpErrorClientNotice, temporaryClientError, unexpectedResponse)
 import qualified Simplex.Messaging.Crypto as C
@@ -634,11 +635,11 @@ getConnectionRatchetAdHash c = withAgentEnv c . getConnectionRatchetAdHash' c
 {-# INLINE getConnectionRatchetAdHash #-}
 
 -- | Test protocol server
-testProtocolServer :: forall p. ProtocolTypeI p => AgentClient -> NetworkRequestMode -> UserId -> ProtoServerWithAuth p -> IO (Maybe ProtocolTestFailure)
+testProtocolServer :: forall p. ProtocolTypeI p => AgentClient -> NetworkRequestMode -> UserId -> ProtoServerWithAuth p -> IO (Either ProtocolTestFailure (Either String ServerPublicInfo))
 testProtocolServer c nm userId srv = withAgentEnv' c $ case protocolTypeI @p of
   SPSMP -> runSMPServerTest c nm userId srv
-  SPXFTP -> runXFTPServerTest c nm userId srv
-  SPNTF -> runNTFServerTest c nm userId srv
+  SPXFTP -> maybe (Right (Left "no info for XFTP")) Left <$> runXFTPServerTest c nm userId srv
+  SPNTF -> maybe (Right (Left "no info for NTF")) Left <$> runNTFServerTest c nm userId srv
 
 -- | set SOCKS5 proxy on/off and optionally set TCP timeouts for fast network
 setNetworkConfig :: AgentClient -> NetworkConfig -> AE ()

src/Simplex/Messaging/Agent/Client.hs

@@ -206,6 +206,7 @@ import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as J
+import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Bifunctor (bimap, first, second)
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
@@ -304,11 +305,12 @@ import Simplex.Messaging.Protocol
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Protocol.Types
 import Simplex.Messaging.Server.QueueStore.QueueInfo
+import Simplex.Messaging.Server.Information (ServerPublicInfo)
 import Simplex.Messaging.Session
 import Simplex.Messaging.SystemTime
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (HandshakeError (..), SMPServiceRole (..), SMPVersion, ServiceCredentials (..), SessionId, THClientService' (..), THandleAuth (..), THandleParams (sessionId, thAuth, thVersion), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion, newNtfCredsSMPVersion)
+import Simplex.Messaging.Transport (HandshakeError (..), SMPServiceRole (..), SMPVersion, ServiceCredentials (..), SessionId, THClientService' (..), THandleAuth (..), THandleParams (sessionId, thAuth, thVersion, serverInfoBytes), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion, newNtfCredsSMPVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials
 import Simplex.Messaging.Util
@@ -1281,7 +1283,7 @@ data ProtocolTestFailure = ProtocolTestFailure
   }
   deriving (Eq, Show)
 
-runSMPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> SMPServerWithAuth -> AM' (Maybe ProtocolTestFailure)
+runSMPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> SMPServerWithAuth -> AM' (Either ProtocolTestFailure (Either String ServerPublicInfo))
 runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth srv auth) = do
   cfg <- getClientConfig c smpCfg
   C.AuthAlg ra <- asks $ rcvAuthAlg . config
@@ -1292,6 +1294,9 @@ runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth sr
     ts <- readTVarIO $ proxySessTs c
     getProtocolClient g nm tSess cfg presetDomains Nothing ts (\_ -> pure ()) >>= \case
       Right smp -> do
+        let serverInfo = case serverInfoBytes (thParams smp) of
+              Nothing -> Left "No server info received"
+              Just bs -> J.eitherDecodeStrict bs
         rKeys@(_, rpKey) <- atomically $ C.generateAuthKeyPair ra g
         (sKey, spKey) <- atomically $ C.generateAuthKeyPair sa g
         (dhKey, _) <- atomically $ C.generateKeyPair g
@@ -1303,8 +1308,10 @@ runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth sr
               _ -> secureSMPQueue smp nm rpKey rcvId sKey
           liftError (testErr TSDeleteQueue) $ deleteSMPQueue smp nm rpKey rcvId
         ok <- netTimeoutInt (tcpTimeout $ networkConfig cfg) nm `timeout` closeProtocolClient smp
-        pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
-      Left e -> pure (Just $ testErr TSConnect e)
+        pure $ case either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok of
+          Just failErr -> Left failErr
+          Nothing -> Right serverInfo
+      Left e -> pure $ Left (testErr TSConnect e)
   where
     addr = B.unpack $ strEncode srv
     testErr :: ProtocolTestStep -> SMPClientError -> ProtocolTestFailure

src/Simplex/Messaging/Client.hs

@@ -230,7 +230,8 @@ smpClientStub g sessionId thVersion thAuth = do
               implySessId = thVersion >= authCmdsSMPVersion,
               encryptBlock = Nothing,
               batch = True,
-              serviceAuth = thVersion >= serviceCertsSMPVersion
+              serviceAuth = thVersion >= serviceCertsSMPVersion,
+              serverInfoBytes = Nothing
             },
         sessionTs = ts,
         client_ =

src/Simplex/Messaging/Notifications/Transport.hs

@@ -186,5 +186,6 @@ ntfTHandle c = THandle {connection = c, params}
           implySessId = False,
           encryptBlock = Nothing,
           batch = False,
-          serviceAuth = False
+          serviceAuth = False,
+          serverInfoBytes = Nothing
         }

src/Simplex/Messaging/Server.hs

@@ -56,6 +56,7 @@ import Control.Monad.Trans.Except
 import Control.Monad.STM (retry)
 import Crypto.Random (ChaChaDRG)
 import Data.Bifunctor (first, second)
+import qualified Data.Aeson as J
 import Data.ByteString.Base64 (encode)
 import qualified Data.ByteString.Builder as BLD
 import Data.ByteString.Char8 (ByteString)
@@ -739,9 +740,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
       idSize <- asks $ queueIdBytes . config
       kh <- asks serverIdentity
       ks <- atomically . C.generateKeyPair =<< asks random
-      ServerConfig {smpServerVRange, smpHandshakeTimeout} <- asks config
+      ServerConfig {smpServerVRange, smpHandshakeTimeout, information} <- asks config
+      let serverInfo = LB.toStrict . J.encode <$> information
       labelMyThread $ "smp handshake for " <> transportName tp
-      liftIO (timeout smpHandshakeTimeout . runExceptT $ smpServerHandshake srvCert srvSignKey h ks kh smpServerVRange $ getClientService ms g idSize) >>= \case
+      liftIO (timeout smpHandshakeTimeout . runExceptT $ smpServerHandshake srvCert srvSignKey h ks kh smpServerVRange serverInfo $ getClientService ms g idSize) >>= \case
         Just (Right th) -> runClientTransport th
         _ -> pure ()
 

src/Simplex/Messaging/Transport.hs

@@ -58,6 +58,7 @@ module Simplex.Messaging.Transport
     clientNoticesSMPVersion,
     rcvServiceSMPVersion,
     namesSMPVersion,
+    serverInfoSMPVersion,
     simplexMQVersion,
     smpBlockSize,
     TransportConfig (..),
@@ -108,7 +109,7 @@ module Simplex.Messaging.Transport
   )
 where
 
-import Control.Applicative (optional)
+import Control.Applicative (optional, (<|>))
 import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Except
@@ -173,6 +174,7 @@ smpBlockSize = 16384
 -- 17 - create notification credentials with NEW (7/12/2025)
 -- 18 - support client notices (10/10/2025)
 -- 19 - service subscriptions to messages (10/20/2025)
+-- 20 - server public information in handshake (7/5/2026)
 
 data SMPVersion
 
@@ -227,6 +229,9 @@ rcvServiceSMPVersion = VersionSMP 19
 namesSMPVersion :: VersionSMP
 namesSMPVersion = VersionSMP 20
 
+serverInfoSMPVersion :: VersionSMP
+serverInfoSMPVersion = VersionSMP 20
+
 minClientSMPRelayVersion :: VersionSMP
 minClientSMPRelayVersion = VersionSMP 6
 
@@ -496,7 +501,9 @@ data THandleParams v p = THandleParams
     -- based on protocol version
     batch :: Bool,
     -- | include service signature (or '0' if it is absent), based on protocol version
-    serviceAuth :: Bool
+    serviceAuth :: Bool,
+    -- | JSON-encoded ServerPublicInfo from handshake, present when server version >= serverInfoSMPVersion
+    serverInfoBytes :: Maybe ByteString
   }
 
 data THandleAuth (p :: TransportPeer) where
@@ -548,7 +555,9 @@ data SMPServerHandshake = SMPServerHandshake
     sessionId :: SessionId,
     -- pub key to agree shared secrets for command authorization and entity ID encryption.
     -- todo C.PublicKeyX25519
-    authPubKey :: Maybe CertChainPubKey
+    authPubKey :: Maybe CertChainPubKey,
+    -- | optional server public information (JSON-encoded ServerPublicInfo), sent when version >= serverInfoSMPVersion
+    serverInfo :: Maybe ByteString
   }
 
 -- This is the third handshake message that SMP server sends to services
@@ -638,16 +647,21 @@ ifHasProxy v a b = if v >= proxyServerHandshakeSMPVersion then a else b
 ifHasService :: VersionSMP -> a -> a -> a
 ifHasService v a b = if v >= serviceCertsSMPVersion then a else b
 
+ifHasServerInfo :: VersionSMP -> a -> a -> a
+ifHasServerInfo v a b = if v >= serverInfoSMPVersion then a else b
+
 instance Encoding SMPServerHandshake where
-  smpEncode SMPServerHandshake {smpVersionRange, sessionId, authPubKey} =
-    smpEncode (smpVersionRange, sessionId) <> auth
+  smpEncode SMPServerHandshake {smpVersionRange, sessionId, authPubKey, serverInfo} =
+    smpEncode (smpVersionRange, sessionId) <> auth <> info
     where
       auth = encodeAuthEncryptCmds (maxVersion smpVersionRange) authPubKey
+      info = ifHasServerInfo (maxVersion smpVersionRange) (smpEncode (Large <$> serverInfo)) ""
   smpP = do
     (smpVersionRange, sessionId) <- smpP
     -- TODO drop SMP v6: remove special parser and make key non-optional
     authPubKey <- authEncryptCmdsP (maxVersion smpVersionRange) smpP
-    pure SMPServerHandshake {smpVersionRange, sessionId, authPubKey}
+    serverInfo <- ifHasServerInfo (maxVersion smpVersionRange) ((fmap unLarge <$> smpP) <|> pure Nothing) (pure Nothing)
+    pure SMPServerHandshake {smpVersionRange, sessionId, authPubKey, serverInfo}
 
 -- newtype for CertificateChain and a session key signed with this certificate
 data CertChainPubKey = CertChainPubKey
@@ -763,12 +777,13 @@ smpServerHandshake ::
   C.KeyPairX25519 ->
   C.KeyHash ->
   VersionRangeSMP ->
+  Maybe ByteString ->
   (SMPServiceRole -> X.CertificateChain -> XV.Fingerprint -> ExceptT TransportError IO ServiceId) ->
   ExceptT TransportError IO (THandleSMP c 'TServer)
-smpServerHandshake srvCert srvSignKey c (k, pk) kh smpVRange getService = do
+smpServerHandshake srvCert srvSignKey c (k, pk) kh smpVRange serverInfo getService = do
   let sk = C.signX509 srvSignKey $ C.publicToX509 k
       smpVersionRange = maybe legacyServerSMPRelayVRange (const smpVRange) $ getSessionALPN c
-  sendHandshake th $ SMPServerHandshake {sessionId, smpVersionRange, authPubKey = Just (CertChainPubKey srvCert sk)}
+  sendHandshake th $ SMPServerHandshake {sessionId, smpVersionRange, authPubKey = Just (CertChainPubKey srvCert sk), serverInfo}
   SMPClientHandshake {smpVersion = v, keyHash, authPubKey = k', proxyServer, clientService} <- getHandshake th
   when (keyHash /= kh) $ throwE $ TEHandshake IDENTITY
   case compatibleVRange' smpVersionRange v of
@@ -801,7 +816,7 @@ smpServerHandshake srvCert srvSignKey c (k, pk) kh smpVRange getService = do
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
 smpClientHandshake :: forall c. Transport c => c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeSMP -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandleSMP c 'TClient)
 smpClientHandshake c ks_ keyHash@(C.KeyHash kh) vRange proxyServer serviceKeys_ = do
-  SMPServerHandshake {sessionId = sessId, smpVersionRange, authPubKey} <- getHandshake th
+  SMPServerHandshake {sessionId = sessId, smpVersionRange, authPubKey, serverInfo} <- getHandshake th
   when (sessionId /= sessId) $ throwE TEBadSession
   -- Below logic downgrades version range in case the "client" is SMP proxy server and it is
   -- connected to the destination server of the version 11 or older.
@@ -838,7 +853,7 @@ smpClientHandshake c ks_ keyHash@(C.KeyHash kh) vRange proxyServer serviceKeys_
           hs = SMPClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_, proxyServer, clientService}
       sendHandshake th hs
       service <- mapM getClientService serviceKeys
-      liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck_ proxyServer service
+      liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck_ proxyServer service serverInfo
     Nothing -> throwE TEVersion
   where
     th@THandle {params = THandleParams {sessionId}} = smpTHandle c
@@ -856,14 +871,14 @@ smpTHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRang
 smpTHandleServer th v vr pk k_ proxyServer peerClientService = do
   let thAuth = Just THAuthServer {serverPrivKey = pk, peerClientService, sessSecret' = (`C.dh'` pk) <$!> k_}
   be <- blockEncryption th v proxyServer thAuth
-  pure $ smpTHandle_ th v vr thAuth $ uncurry TSbChainKeys <$> be
+  pure $ smpTHandle_ th v vr thAuth (uncurry TSbChainKeys <$> be) Nothing
 
-smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, CertChainPubKey) -> Bool -> Maybe THClientService -> IO (THandleSMP c 'TClient)
-smpTHandleClient th v vr pk_ ck_ proxyServer clientService = do
+smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, CertChainPubKey) -> Bool -> Maybe THClientService -> Maybe ByteString -> IO (THandleSMP c 'TClient)
+smpTHandleClient th v vr pk_ ck_ proxyServer clientService serverInfoBytes = do
   let thAuth = clientTHParams <$!> ck_
   be <- blockEncryption th v proxyServer thAuth
   -- swap is needed to use client's sndKey as server's rcvKey and vice versa
-  pure $ smpTHandle_ th v vr thAuth $ uncurry TSbChainKeys . swap <$> be
+  pure $ smpTHandle_ th v vr thAuth (uncurry TSbChainKeys . swap <$> be) serverInfoBytes
   where
     clientTHParams (k, ck) =
       THAuthClient
@@ -883,8 +898,8 @@ blockEncryption THandle {params = THandleParams {sessionId}} v proxyServer = \ca
     be :: Maybe C.DhSecretX25519 -> IO (Maybe (TVar C.SbChainKey, TVar C.SbChainKey))
     be = mapM $ \(C.DhSecretX25519 secret) -> bimapM newTVarIO newTVarIO $ C.sbcInit sessionId secret
 
-smpTHandle_ :: forall c p. THandleSMP c p -> VersionSMP -> VersionRangeSMP -> Maybe (THandleAuth p) -> Maybe TSbChainKeys -> THandleSMP c p
-smpTHandle_ th@THandle {params} v vr thAuth encryptBlock =
+smpTHandle_ :: forall c p. THandleSMP c p -> VersionSMP -> VersionRangeSMP -> Maybe (THandleAuth p) -> Maybe TSbChainKeys -> Maybe ByteString -> THandleSMP c p
+smpTHandle_ th@THandle {params} v vr thAuth encryptBlock serverInfoBytes =
   -- TODO drop SMP v6: make thAuth non-optional
   -- * Note: update version-based parameters in smpTHParamsSetVersion as well.
   let params' =
@@ -894,7 +909,8 @@ smpTHandle_ th@THandle {params} v vr thAuth encryptBlock =
             thAuth,
             implySessId = v >= authCmdsSMPVersion,
             encryptBlock,
-            serviceAuth = v >= serviceCertsSMPVersion -- optional service signature will be encoded for all commands and responses
+            serviceAuth = v >= serviceCertsSMPVersion, -- optional service signature will be encoded for all commands and responses
+            serverInfoBytes
           }
    in (th :: THandleSMP c p) {params = params'}
 
@@ -933,7 +949,8 @@ smpTHandle c = THandle {connection = c, params}
           implySessId = False,
           encryptBlock = Nothing,
           batch = True,
-          serviceAuth = False
+          serviceAuth = False,
+          serverInfoBytes = Nothing
         }
 
 $(J.deriveJSON (sumTypeJSON id) ''HandshakeError)

tests/AgentTests/FunctionalAPITests.hs

@@ -3629,7 +3629,7 @@ testSMPServerConnectionTest (t, msType) newQueueBasicAuth srv =
   withSmpServerConfigOn t cfg' testPort2 $ \_ -> do
     -- initially passed server is not running
     withAgent 1 agentCfg initAgentServers testDB $ \a ->
-      testProtocolServer a NRMInteractive 1 srv
+      either Just (const Nothing) <$> testProtocolServer a NRMInteractive 1 srv
   where
     cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {newQueueBasicAuth}
 

tests/AgentTests/NotificationTests.hs

@@ -540,7 +540,7 @@ testRunNTFServerTests :: ASrvTransport -> NtfServer -> IO (Maybe ProtocolTestFai
 testRunNTFServerTests t srv =
   withNtfServer t $
     withAgent 1 agentCfg initAgentServers testDB $ \a ->
-      testProtocolServer a NRMInteractive 1 $ ProtoServerWithAuth srv Nothing
+      either Just (const Nothing) <$> testProtocolServer a NRMInteractive 1 (ProtoServerWithAuth srv Nothing)
 
 testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
 testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do

tests/CoreTests/BatchingTests.hs

@@ -421,7 +421,8 @@ testTHandleParams v sessionId =
       implySessId = v >= authCmdsSMPVersion,
       encryptBlock = Nothing,
       batch = True,
-      serviceAuth = v >= serviceCertsSMPVersion
+      serviceAuth = v >= serviceCertsSMPVersion,
+      serverInfoBytes = Nothing
     }
 
 testTHandleAuth :: VersionSMP -> TVar ChaChaDRG -> C.APublicAuthKey -> IO (Maybe (THandleAuth 'TClient))