feat: add server public information handling in XFTP protocol (#1846)

* feat: add server public information handling in XFTP protocol

* test

---------

Co-authored-by: sh <github.shum@liber.li>
Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>

protocol/xftp.md

@@ -1,4 +1,4 @@
-Version 3, 2025-01-24
+Version 4, 2026-08-08
 
 # SimpleX File Transfer Protocol
 
@@ -50,11 +50,12 @@ The objective of SimpleX File Transfer Protocol (XFTP) is to facilitate the secu
 
 XFTP is implemented as an application level protocol on top of HTTP2 and TLS.
 
-This document describes XFTP protocol version 3. The version history:
+This document describes XFTP protocol version 4. The version history:
 
 - v1: initial version
 - v2: authenticated commands - added basic auth support for commands
 - v3: blocked files - added BLOCKED error type for policy violations
+- v4: server public information in handshake
 
 The protocol describes the set of commands that senders and recipients can send to XFTP routers to create, upload, download and delete data packets of several pre-defined sizes. XFTP routers SHOULD support packets of 4 sizes: 64KB, 256KB, 1MB and 4MB (1KB = 1024 bytes, 1MB = 1024KB).
 

src/Simplex/FileTransfer/Client.hs

@@ -38,6 +38,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
+import qualified Data.Aeson as J
 import Data.Bifunctor (first)
 import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Char8 (ByteString)
@@ -155,12 +156,13 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
 
 xftpClientHandshakeV1 :: VersionRangeXFTP -> C.KeyHash -> HTTP2Client -> THandleParamsXFTP 'TClient -> ExceptT XFTPClientError IO (THandleParamsXFTP 'TClient)
 xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {sessionId, serverKey} thParams0 = do
-  shs@XFTPServerHandshake {authPubKey = ck} <- getServerHandshake
+  shs@XFTPServerHandshake {authPubKey = ck, serverInfoBytes} <- getServerHandshake
   (vr, sk) <- processServerHandshake shs
   let v = maxVersion vr
   sendClientHandshake XFTPClientHandshake {xftpVersion = v, keyHash}
   let thAuth = Just THAuthClient {peerServerPubKey = sk, peerServerCertKey = ck, clientService = Nothing, sessSecret = Nothing}
-  pure thParams0 {thAuth, thVersion = v, thServerVRange = vr}
+      serverInfo = J.eitherDecodeStrict' <$> serverInfoBytes
+  pure thParams0 {thAuth, thVersion = v, thServerVRange = vr, serverInfo}
   where
     getServerHandshake :: ExceptT XFTPClientError IO XFTPServerHandshake
     getServerHandshake = do

src/Simplex/FileTransfer/Server.hs

@@ -23,11 +23,13 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
 import Control.Monad.Trans.Except
+import qualified Data.Aeson as J
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
@@ -124,7 +126,7 @@ data Handshake
   | HandshakeAccepted (THandleParams XFTPVersion 'TServer)
 
 xftpServer :: forall s. FileStoreClass s => XFTPServerConfig s -> TMVar Bool -> M s ()
-xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration, xftpServerVRange} started = do
+xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration, xftpServerVRange, information} started = do
   mapM_ (expireServerFiles Nothing) fileExpiration
   restoreServerStats
   raceAny_
@@ -202,7 +204,8 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
               fst kp <$ TM.insert sessionId (HandshakeSent $ snd kp) sessions
           let authPubKey = CertChainPubKey chain (C.signX509 serverSignKey $ C.publicToX509 k)
               webIdentityProof = C.sign serverSignKey . (<> sessionId) <$> challenge_
-          let hs = XFTPServerHandshake {xftpVersionRange = xftpServerVRange, sessionId, authPubKey, webIdentityProof}
+              serverInfoBytes = LB.toStrict . J.encode <$> information
+          let hs = XFTPServerHandshake {xftpVersionRange = xftpServerVRange, sessionId, authPubKey, webIdentityProof, serverInfoBytes}
           shs <- encodeXftp hs
 #ifdef slow_servers
           lift randomDelay

src/Simplex/FileTransfer/Server/Env.hs

@@ -64,6 +64,7 @@ import Simplex.FileTransfer.Transport (VersionRangeXFTP)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (BasicAuth, RcvPublicAuthKey)
 import Simplex.Messaging.Server.Expiration
+import Simplex.Messaging.Server.Information (ServerPublicInfo)
 import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), loadFingerprint, loadServerCredential)
 import Simplex.Messaging.Util (tshow)
 import System.IO (IOMode (..))
@@ -97,6 +98,8 @@ data XFTPServerConfig s = XFTPServerConfig
     httpCredentials :: Maybe ServerCredentials,
     -- | XFTP client-server protocol version range
     xftpServerVRange :: VersionRangeXFTP,
+    -- | server public information sent in handshake and used to generate static mini-site
+    information :: Maybe ServerPublicInfo,
     -- stats config - see SMP server config
     logStatsInterval :: Maybe Int64,
     logStatsStartTime :: Int64,

src/Simplex/FileTransfer/Server/Main.hs

@@ -306,6 +306,7 @@ xftpServerCLI_ generateSite serveStaticFiles cfgPath logPath = do
                   },
               httpCredentials = httpCredentials_,
               xftpServerVRange = supportedFileServerVRange,
+              information = serverPublicInfo ini,
               logStatsInterval = logStats $> 86400, -- seconds
               logStatsStartTime = 0, -- seconds from 00:00 UTC
               serverStatsLogFile = combine logPath "file-server-stats.daily.log",

src/Simplex/FileTransfer/Transport.hs

@@ -12,6 +12,7 @@ module Simplex.FileTransfer.Transport
   ( supportedFileServerVRange,
     authCmdsXFTPVersion,
     blockedFilesXFTPVersion,
+    serverInfoXFTPVersion,
     xftpClientHandshakeStub,
     alpnSupportedXFTPhandshakes,
     xftpALPNv1,
@@ -36,7 +37,6 @@ module Simplex.FileTransfer.Transport
   )
 where
 
-import Control.Applicative (optional)
 import qualified Control.Exception as E
 import Control.Logger.Simple
 import Control.Monad
@@ -62,7 +62,7 @@ import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol (BlockingInfo, CommandError)
 import Simplex.Messaging.Transport (ALPN, CertChainPubKey, ServiceCredentials, SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
 import Simplex.Messaging.Transport.HTTP2.File
-import Simplex.Messaging.Util (bshow, tshow, (<$?>))
+import Simplex.Messaging.Util (bshow, tshow, (<$?>), (<$$>))
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
 import System.IO (Handle, IOMode (..), withFile)
@@ -97,8 +97,11 @@ authCmdsXFTPVersion = VersionXFTP 2
 blockedFilesXFTPVersion :: VersionXFTP
 blockedFilesXFTPVersion = VersionXFTP 3
 
+serverInfoXFTPVersion :: VersionXFTP
+serverInfoXFTPVersion = VersionXFTP 4
+
 currentXFTPVersion :: VersionXFTP
-currentXFTPVersion = VersionXFTP 3
+currentXFTPVersion = VersionXFTP 4
 
 supportedFileServerVRange :: VersionRangeXFTP
 supportedFileServerVRange = mkVersionRange initialXFTPVersion currentXFTPVersion
@@ -124,7 +127,9 @@ data XFTPServerHandshake = XFTPServerHandshake
     -- | pub key to agree shared secrets for command authorization and entity ID encryption.
     authPubKey :: CertChainPubKey,
     -- | signed identity challenge from  XFTPClientHello
-    webIdentityProof :: Maybe C.ASignature
+    webIdentityProof :: Maybe C.ASignature,
+    -- | optional server public information (JSON-encoded ServerPublicInfo), sent when version >= serverInfoXFTPVersion
+    serverInfoBytes :: Maybe ByteString
   }
 
 data XFTPClientHandshake = XFTPClientHandshake
@@ -151,13 +156,21 @@ instance Encoding XFTPClientHandshake where
     pure XFTPClientHandshake {xftpVersion, keyHash}
 
 instance Encoding XFTPServerHandshake where
-  smpEncode XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey, webIdentityProof} =
-    smpEncode (xftpVersionRange, sessionId, authPubKey, C.signatureBytes webIdentityProof)
+  smpEncode XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey, webIdentityProof, serverInfoBytes} =
+    smpEncode (xftpVersionRange, sessionId, authPubKey, C.signatureBytes webIdentityProof) <> info
+    where
+      info = ifHasServerInfo (maxVersion xftpVersionRange) (smpEncode (Large <$> serverInfoBytes)) ""
   smpP = do
     (xftpVersionRange, sessionId, authPubKey) <- smpP
-    webIdentityProof <- optional $ C.decodeSignature <$?> smpP
+    -- decode the (length-prefixed) signature bytes deterministically: empty bytes decode to Nothing.
+    -- (Must not use `optional`, which would backtrack and leave the bytes for the parsers that follow.)
+    webIdentityProof <- C.decodeSignature <$?> smpP
+    serverInfoBytes <- ifHasServerInfo (maxVersion xftpVersionRange) (unLarge <$$> smpP) (pure Nothing)
     Tail _compat <- smpP
-    pure XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey, webIdentityProof}
+    pure XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey, webIdentityProof, serverInfoBytes}
+
+ifHasServerInfo :: VersionXFTP -> a -> a -> a
+ifHasServerInfo v a b = if v >= serverInfoXFTPVersion then a else b
 
 sendEncFile :: Handle -> (Builder -> IO ()) -> LC.SbState -> Word32 -> IO ()
 sendEncFile h send = go

src/Simplex/Messaging/Agent.hs

@@ -679,7 +679,7 @@ getConnectionRatchetAdHash c = withAgentEnv c . getConnectionRatchetAdHash' c
 testProtocolServer :: forall p. ProtocolTypeI p => AgentClient -> NetworkRequestMode -> UserId -> ProtoServerWithAuth p -> IO (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
 testProtocolServer c nm userId srv = withAgentEnv' c $ case protocolTypeI @p of
   SPSMP -> runSMPServerTest c nm userId srv
-  SPXFTP -> maybe (Right Nothing) Left <$> runXFTPServerTest c nm userId srv
+  SPXFTP -> runXFTPServerTest c nm userId srv
   SPNTF -> maybe (Right Nothing) Left <$> runNTFServerTest c nm userId srv
 
 -- | set SOCKS5 proxy on/off and optionally set TCP timeouts for fast network

src/Simplex/Messaging/Agent/Client.hs

@@ -1326,7 +1326,7 @@ runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth sr
     testErr :: ProtocolTestStep -> SMPClientError -> ProtocolTestFailure
     testErr step = ProtocolTestFailure step . protocolClientError SMP addr
 
-runXFTPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> XFTPServerWithAuth -> AM' (Maybe ProtocolTestFailure)
+runXFTPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> XFTPServerWithAuth -> AM' (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
 runXFTPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth srv auth) = do
   cfg <- asks $ xftpCfg . config
   g <- asks random
@@ -1352,8 +1352,8 @@ runXFTPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth s
           unless (digest == rcvDigest) $ throwE $ ProtocolTestFailure TSCompareFile $ XFTP (B.unpack $ strEncode srv) DIGEST
           liftError (testErr TSDeleteFile) $ X.deleteXFTPChunk xftp spKey sId
         ok <- netTimeoutInt (tcpTimeout xftpNetworkConfig) nm `timeout` X.closeXFTPClient xftp
-        pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
-      Left e -> pure (Just $ testErr TSConnect e)
+        pure $ r >> maybe (Left (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const $ Right $ serverInfo (X.thParams xftp)) ok
+      Left e -> pure $ Left (testErr TSConnect e)
   where
     addr = B.unpack $ strEncode srv
     testErr :: ProtocolTestStep -> XFTPClientError -> ProtocolTestFailure

src/Simplex/Messaging/Transport.hs

@@ -105,7 +105,6 @@ where
 
 import Control.Applicative (optional)
 import Control.Concurrent.STM
-import Control.Logger.Simple (logWarn)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
@@ -341,15 +340,12 @@ type ALPN = ByteString
 
 connectTLS :: T.TLSParams p => Maybe HostName -> TransportConfig -> p -> Socket -> IO T.Context
 connectTLS host_ TransportConfig {logTLSErrors} params sock =
-  E.bracketOnError (T.contextNew sock params) closeTLS $ \ctx -> do
-    logWarn $ "TLS: " <> peer <> " handshake starting"
-    logHandshakeErrors (T.handshake ctx)
-    logWarn ("TLS: " <> peer <> " handshake complete") $> ctx
+  E.bracketOnError (T.contextNew sock params) closeTLS $ \ctx ->
+    logHandshakeErrors (T.handshake ctx) $> ctx
   where
     logHandshakeErrors = if logTLSErrors then (`catchAll` logThrow) else id
     logThrow e = putStrLn ("TLS error" <> host <> ": " <> show e) >> E.throwIO e
     host = maybe "" (\h -> " (" <> h <> ")") host_
-    peer = maybe "server" (const "client") host_
 
 getTLS :: forall p. TransportPeerI p => TransportConfig -> Bool -> X.CertificateChain -> T.Context -> IO (TLS p)
 getTLS cfg tlsCertSent tlsPeerCert cxt = withTlsUnique @TLS @p cxt newTLS

src/Simplex/Messaging/Transport/Client.hs

@@ -29,7 +29,7 @@ module Simplex.Messaging.Transport.Client
 where
 
 import Control.Applicative (optional, (<|>))
-import Control.Logger.Simple (logError, logWarn)
+import Control.Logger.Simple (logError)
 import Control.Monad
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -181,9 +181,7 @@ runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy,
     tls <- set CHContext $ connectTLS (Just hostName) tCfg clientParams sock
     chain <- takePeerCertChain serverCert
     sent <- readIORef clientCredsSent
-    c <- set CHTransport (getTransportConnection tCfg sent chain tls)
-    logWarn $ "ALPN: client negotiated " <> tshow (getSessionALPN c)
-    client c
+    client =<< set CHTransport (getTransportConnection tCfg sent chain tls)
   where
     closeConn = readIORef >=> mapM_ (\c -> E.uninterruptibleMask_ $ closeConn_ c `catchAll_` pure ())
     closeConn_ = \case
@@ -296,25 +294,19 @@ mkTLSClientParams supported caStore_ host port cafp_ clientCreds_ clientCredsSen
         def
           { T.onServerCertificate = onServerCert,
             T.onCertificateRequest = onCertRequest,
-            T.onSuggestALPN = alpn_ <$ logWarn ("ALPN: client offering " <> tshow alpn_),
-            T.onCustomFFDHEGroup = \dh pub -> do
-              logWarn "TLS client hook onCustomFFDHEGroup"
-              (T.onCustomFFDHEGroup def) dh pub
+            T.onSuggestALPN = pure alpn_
           },
       T.clientSupported = supported
     }
   where
     p = B.pack port
     onServerCert _ _ _ cc = do
-      logWarn "TLS: client received server certificate"
       errs <- maybe def (\ca -> validateCertificateChain ca host p cc) cafp_
       atomically $ putTMVar serverCerts $ if null errs then Just cc else Nothing
       pure errs
-    onCertRequest _ = do
-      logWarn "TLS: client received certificate request"
-      case clientCreds_ of
-        Just _ -> clientCreds_ <$ writeIORef clientCredsSent True
-        Nothing -> pure Nothing
+    onCertRequest = case clientCreds_ of
+      Just _ -> \_ -> clientCreds_ <$ writeIORef clientCredsSent True
+      Nothing -> \_ -> pure Nothing
 
 validateCertificateChain :: C.KeyHash -> HostName -> ByteString -> X.CertificateChain -> IO [XV.FailedReason]
 validateCertificateChain (C.KeyHash kh) host port cc = case chainIdCaCerts cc of

src/Simplex/Messaging/Transport/Server.hs

@@ -31,7 +31,6 @@ module Simplex.Messaging.Transport.Server
   )
 where
 
-import Debug.Trace
 import Control.Applicative ((<|>))
 import Control.Logger.Simple
 import Control.Monad
@@ -140,7 +139,6 @@ runTransportServerSocketState ss started getSocket threadLabel srvSupported srvC
       sniUsed <- newTVarIO False
       let srvParams = supportedTLSServerParams srvSupported srvCreds sniUsed $ serverALPN cfg
       h <- setupTLS_ srvParams
-      logWarn $ "ALPN: server negotiated " <> tshow (getSessionALPN h)
       sni <- readTVarIO sniUsed
       pure (sni, h)
       where
@@ -263,28 +261,12 @@ supportedTLSServerParams serverSupported TLSServerCredential {credential, sniCre
     { T.serverWantClientCert = False,
       T.serverHooks =
         def
-          { T.onServerNameIndication = \sni -> do
-              logWarn $ "TLS: server received SNI " <> tshow sni
-              case sniCredential of
+          { T.onServerNameIndication = case sniCredential of
+              Nothing -> \_ -> pure $ T.Credentials [credential]
+              Just sniCred -> \case
                 Nothing -> pure $ T.Credentials [credential]
-                Just sniCred -> case sni of
-                  Nothing -> pure $ T.Credentials [credential]
-                  Just _host -> T.Credentials [sniCred] <$ atomically (writeTVar sniCredUsed True),
-            T.onALPNClientSuggest =
-              ( \alpn protos -> do
-                  let proto = fromMaybe "" $ find (`elem` alpn) protos
-                  logWarn $ "ALPN: client offered " <> tshow protos <> ", server selected " <> tshow proto
-                  pure proto
-              )
-                <$> alpn_,
-            T.onCipherChoosing = \v cs ->
-              traceShow "TLS: server hook onCipherChoosing" $ (T.onCipherChoosing def) v cs,
-            T.onNewHandshake = \m -> do
-              logWarn "TLS: server hook onNewHandshake"
-              (T.onNewHandshake def) m,
-            T.onEncryptedExtensionsCreating = \es -> do
-              logWarn "TLS: server hook onEncryptedExtensionsCreating"
-              (T.onEncryptedExtensionsCreating def) es
+                Just _host -> T.Credentials [sniCred] <$ atomically (writeTVar sniCredUsed True),
+            T.onALPNClientSuggest = (\alpn -> pure . fromMaybe "" . find (`elem` alpn)) <$> alpn_
           },
       T.serverSupported = serverSupported
     }
@@ -295,8 +277,7 @@ paramsAskClientCert clientCert params =
     { T.serverWantClientCert = True,
       T.serverHooks =
         (T.serverHooks params)
-          { T.onClientCertificate = \cc -> do
-              logWarn "TLS: server received client certificate"
+          { T.onClientCertificate = \cc ->
               validateClientCertificate cc >>= \case
                 Just reason -> T.CertificateUsageReject reason <$ atomically (tryPutTMVar clientCert Nothing)
                 Nothing -> T.CertificateUsageAccept <$ atomically (tryPutTMVar clientCert $ Just cc)

tests/AgentTests/FunctionalAPITests.hs

@@ -54,6 +54,7 @@ module AgentTests.FunctionalAPITests
     pattern SENT,
     agentCfgVPrevPQ,
     agentCfgV7,
+    testServerInformation,
   )
 where
 

tests/XFTPAgent.hs

@@ -10,7 +10,7 @@
 
 module XFTPAgent where
 
-import AgentTests.FunctionalAPITests (get, rfGet, runRight, runRight_, sfGet, withAgent)
+import AgentTests.FunctionalAPITests (get, rfGet, runRight, runRight_, sfGet, withAgent, testServerInformation)
 
 import Control.Logger.Simple
 import Control.Monad
@@ -83,7 +83,7 @@ xftpAgentTests =
       it "if file is expired on server, should report error and continue receiving next file" testXFTPAgentExpiredOnServer
       it "should request additional recipient IDs when number of recipients exceeds maximum per request" testXFTPAgentRequestAdditionalRecipientIDs
       describe "XFTP server test via agent API" $ do
-        it "should pass without basic auth" $ \_ -> testXFTPServerTest Nothing (noAuthSrv testXFTPServer2) `shouldReturn` Right Nothing
+        it "should pass without basic auth" $ \_ -> testXFTPServerTest Nothing (noAuthSrv testXFTPServer2) `shouldReturn` Right (Just (Right testServerInformation))
         let srv1 = testXFTPServer2 {keyHash = "1234"}
         it "should fail with incorrect fingerprint" $ \_ -> do
           testXFTPServerTest Nothing (noAuthSrv srv1) `shouldReturn` Left (ProtocolTestFailure TSConnect $ BROKER (B.unpack $ strEncode srv1) $ NETWORK NEUnknownCAError)
@@ -91,13 +91,13 @@ xftpAgentTests =
           let auth = Just "abcd"
               srv = ProtoServerWithAuth testXFTPServer2
               authErr = ProtocolTestFailure TSCreateFile $ XFTP (B.unpack $ strEncode testXFTPServer2) AUTH
-          it "should pass with correct password" $ \_ -> testXFTPServerTest auth (srv auth) `shouldReturn` Right Nothing
+          it "should pass with correct password" $ \_ -> testXFTPServerTest auth (srv auth) `shouldReturn` Right (Just (Right testServerInformation))
           it "should fail without password" $ \_ -> testXFTPServerTest auth (srv Nothing) `shouldReturn` Left authErr
           it "should fail with incorrect password" $ \_ -> testXFTPServerTest auth (srv $ Just "wrong") `shouldReturn` Left authErr
 
 testXFTPServerTest :: HasCallStack => Maybe BasicAuth -> XFTPServerWithAuth -> IO (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
 testXFTPServerTest newFileBasicAuth srv =
-  withXFTPServerCfg testXFTPServerConfig {newFileBasicAuth, xftpPort = xftpTestPort2} $ \_ ->
+  withXFTPServerCfg testXFTPServerConfig {newFileBasicAuth, xftpPort = xftpTestPort2, information = Just testServerInformation} $ \_ ->
     -- initially passed server is not running
     withAgent 1 agentCfg initAgentServers testDB $ \a ->
       testProtocolServer a NRMInteractive 1 srv

tests/XFTPClient.hs

@@ -192,6 +192,7 @@ testXFTPServerConfig =
           },
       httpCredentials = Nothing,
       xftpServerVRange = supportedFileServerVRange,
+      information = Nothing,
       logStatsInterval = Nothing,
       logStatsStartTime = 0,
       serverStatsLogFile = "tests/tmp/xftp-server-stats.daily.log",