server information

src/Simplex/Messaging/Agent.hs

@@ -641,11 +641,11 @@ getConnectionRatchetAdHash c = withAgentEnv c . getConnectionRatchetAdHash' c
 {-# INLINE getConnectionRatchetAdHash #-}
 
 -- | Test protocol server
-testProtocolServer :: forall p. ProtocolTypeI p => AgentClient -> NetworkRequestMode -> UserId -> ProtoServerWithAuth p -> IO (Either ProtocolTestFailure (Either String ServerPublicInfo))
+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 (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
+  SPXFTP -> maybe (Right Nothing) Left <$> 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
 setNetworkConfig :: AgentClient -> NetworkConfig -> AE ()

src/Simplex/Messaging/Agent/Client.hs

@@ -206,7 +206,6 @@ 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)
@@ -310,7 +309,7 @@ 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, serverInfoBytes), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion, newNtfCredsSMPVersion)
+import Simplex.Messaging.Transport (HandshakeError (..), SMPServiceRole (..), SMPVersion, ServiceCredentials (..), SessionId, THClientService' (..), THandleAuth (..), THandleParams (sessionId, thAuth, thVersion, serverInfo), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion, newNtfCredsSMPVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials
 import Simplex.Messaging.Util
@@ -1283,7 +1282,7 @@ data ProtocolTestFailure = ProtocolTestFailure
   }
   deriving (Eq, Show)
 
-runSMPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> SMPServerWithAuth -> AM' (Either ProtocolTestFailure (Either String ServerPublicInfo))
+runSMPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> SMPServerWithAuth -> AM' (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
 runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth srv auth) = do
   cfg <- getClientConfig c smpCfg
   C.AuthAlg ra <- asks $ rcvAuthAlg . config
@@ -1294,9 +1293,6 @@ 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
@@ -1308,9 +1304,7 @@ 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 $ case either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok of
-          Just failErr -> Left failErr
-          Nothing -> Right serverInfo
+        pure $ r >> maybe (Left (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const $ Right $ serverInfo (thParams smp)) ok
       Left e -> pure $ Left (testErr TSConnect e)
   where
     addr = B.unpack $ strEncode srv

src/Simplex/Messaging/Client.hs

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

src/Simplex/Messaging/Notifications/Transport.hs

@@ -187,5 +187,5 @@ ntfTHandle c = THandle {connection = c, params}
           encryptBlock = Nothing,
           batch = False,
           serviceAuth = False,
-          serverInfoBytes = Nothing
+          serverInfo = Nothing
         }

src/Simplex/Messaging/Server/Information.hs

@@ -26,7 +26,6 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Int (Int64)
 import Data.Maybe (isJust)
 import Data.Text (Text)
-import Simplex.Messaging.Agent.Protocol (ConnectionLink, ConnectionMode (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
 
@@ -112,7 +111,7 @@ data Entity = Entity {name :: Text, country :: Maybe Text}
   deriving (Show)
 
 data ServerContactAddress = ServerContactAddress
-  { simplex :: Maybe (ConnectionLink 'CMContact),
+  { simplex :: Maybe Text,
     email :: Maybe Text, -- it is recommended that it matches DNS email address, if either is present
     pgp :: Maybe PGPKey
   }

src/Simplex/Messaging/Server/Main.hs

@@ -59,7 +59,7 @@ import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import qualified Data.Text.IO as T
 import Options.Applicative
-import Simplex.Messaging.Agent.Protocol (ConnectionLink (..), connReqUriP')
+import Simplex.Messaging.Agent.Protocol (ConnectionLink (..), ConnectionMode (..), connReqUriP')
 import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SMPWebPortServers (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
@@ -85,7 +85,7 @@ import Simplex.Messaging.Transport (supportedProxyClientSMPRelayVRange, alpnSupp
 import Simplex.Messaging.Transport.Client (TransportHost (..), defaultSocksProxy)
 import Simplex.Messaging.Transport.HTTP2 (httpALPN)
 import Simplex.Messaging.Transport.Server (ServerCredentials (..), mkTransportServerConfig)
-import Simplex.Messaging.Util (eitherToMaybe, ifM)
+import Simplex.Messaging.Util (eitherToMaybe, ifM, safeDecodeUtf8)
 import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
@@ -786,12 +786,13 @@ serverPublicInfo ini = serverInfo <$!> infoValue "source_code"
         <$!> infoValue nameField
     countryValue field = (either error id . validCountryValue (T.unpack field) . T.unpack) <$!> infoValue field
     iniContacts simplexField emailField pgpKeyUriField pgpKeyFingerprintField =
-      let simplex = either error id . parseAll linkP . encodeUtf8 <$!> eitherToMaybe (lookupValue "INFORMATION" simplexField ini)
+      let addr :: Maybe (ConnectionLink 'CMContact) = either error id . parseAll linkP . encodeUtf8 <$!> eitherToMaybe (lookupValue "INFORMATION" simplexField ini)
+          simplex = safeDecodeUtf8 . strEncode <$> addr
           linkP = CLFull <$> connReqUriP' Nothing <|> CLShort <$> strP
           email = infoValue emailField
           pkURI_ = infoValue pgpKeyUriField
           pkFingerprint_ = infoValue pgpKeyFingerprintField
-       in case (simplex, email, pkURI_, pkFingerprint_) of
+       in case (addr, email, pkURI_, pkFingerprint_) of
             (Nothing, Nothing, Nothing, _) -> Nothing
             (Nothing, Nothing, _, Nothing) -> Nothing
             (_, _, pkURI, pkFingerprint) -> Just ServerContactAddress {simplex, email, pgp = PGPKey <$> pkURI <*> pkFingerprint}

src/Simplex/Messaging/Server/Web.hs

@@ -270,14 +270,14 @@ serverInfoSubsts simplexmqSource information =
       ]
     admin ServerContactAddress {simplex, email, pgp} =
       [ ("admin", Just ""),
-        ("adminSimplex", strEncode <$> simplex),
+        ("adminSimplex", encodeUtf8 <$> simplex),
         ("adminEmail", encodeUtf8 <$> email),
         ("adminPGP", encodeUtf8 . pkURI <$> pgp),
         ("adminPGPFingerprint", encodeUtf8 . pkFingerprint <$> pgp)
       ]
     complaints ServerContactAddress {simplex, email, pgp} =
       [ ("complaints", Just ""),
-        ("complaintsSimplex", strEncode <$> simplex),
+        ("complaintsSimplex", encodeUtf8 <$> simplex),
         ("complaintsEmail", encodeUtf8 <$> email),
         ("complaintsPGP", encodeUtf8 . pkURI <$> pgp),
         ("complaintsPGPFingerprint", encodeUtf8 . pkFingerprint <$> pgp)

src/Simplex/Messaging/Transport.hs

@@ -109,12 +109,13 @@ module Simplex.Messaging.Transport
   )
 where
 
-import Control.Applicative (optional, (<|>))
+import Control.Applicative (optional)
 import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Except (throwE)
+import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -141,9 +142,10 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, parseRead1, sumTypeJSON)
+import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Transport.Buffer
 import Simplex.Messaging.Transport.Shared
-import Simplex.Messaging.Util (bshow, catchAll, catchAll_, liftEitherWith)
+import Simplex.Messaging.Util (bshow, catchAll, catchAll_, liftEitherWith, (<$$>))
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
 import System.IO.Error (isEOFError)
@@ -503,7 +505,7 @@ data THandleParams v p = THandleParams
     -- | include service signature (or '0' if it is absent), based on protocol version
     serviceAuth :: Bool,
     -- | JSON-encoded ServerPublicInfo from handshake, present when server version >= serverInfoSMPVersion
-    serverInfoBytes :: Maybe ByteString
+    serverInfo :: Maybe (Either String ServerPublicInfo)
   }
 
 data THandleAuth (p :: TransportPeer) where
@@ -557,7 +559,7 @@ data SMPServerHandshake = SMPServerHandshake
     -- todo C.PublicKeyX25519
     authPubKey :: Maybe CertChainPubKey,
     -- | optional server public information (JSON-encoded ServerPublicInfo), sent when version >= serverInfoSMPVersion
-    serverInfo :: Maybe ByteString
+    serverInfoBytes :: Maybe ByteString
   }
 
 -- This is the third handshake message that SMP server sends to services
@@ -651,17 +653,17 @@ 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, serverInfo} =
+  smpEncode SMPServerHandshake {smpVersionRange, sessionId, authPubKey, serverInfoBytes} =
     smpEncode (smpVersionRange, sessionId) <> auth <> info
     where
       auth = encodeAuthEncryptCmds (maxVersion smpVersionRange) authPubKey
-      info = ifHasServerInfo (maxVersion smpVersionRange) (smpEncode (Large <$> serverInfo)) ""
+      info = ifHasServerInfo (maxVersion smpVersionRange) (smpEncode (Large <$> serverInfoBytes)) ""
   smpP = do
     (smpVersionRange, sessionId) <- smpP
     -- TODO drop SMP v6: remove special parser and make key non-optional
     authPubKey <- authEncryptCmdsP (maxVersion smpVersionRange) smpP
-    serverInfo <- ifHasServerInfo (maxVersion smpVersionRange) ((fmap unLarge <$> smpP) <|> pure Nothing) (pure Nothing)
-    pure SMPServerHandshake {smpVersionRange, sessionId, authPubKey, serverInfo}
+    serverInfoBytes <- ifHasServerInfo (maxVersion smpVersionRange) (unLarge <$$> smpP) (pure Nothing)
+    pure SMPServerHandshake {smpVersionRange, sessionId, authPubKey, serverInfoBytes}
 
 -- newtype for CertificateChain and a session key signed with this certificate
 data CertChainPubKey = CertChainPubKey
@@ -780,10 +782,10 @@ smpServerHandshake ::
   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 serverInfo getService = do
+smpServerHandshake srvCert srvSignKey c (k, pk) kh smpVRange serverInfoBytes 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), serverInfo}
+  sendHandshake th $ SMPServerHandshake {sessionId, smpVersionRange, authPubKey = Just (CertChainPubKey srvCert sk), serverInfoBytes}
   SMPClientHandshake {smpVersion = v, keyHash, authPubKey = k', proxyServer, clientService} <- getHandshake th
   when (keyHash /= kh) $ throwE $ TEHandshake IDENTITY
   case compatibleVRange' smpVersionRange v of
@@ -816,7 +818,7 @@ smpServerHandshake srvCert srvSignKey c (k, pk) kh smpVRange serverInfo getServi
 -- 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, serverInfo} <- getHandshake th
+  SMPServerHandshake {sessionId = sessId, smpVersionRange, authPubKey, serverInfoBytes} <- 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.
@@ -853,7 +855,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 serverInfo
+      liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck_ proxyServer service serverInfoBytes
     Nothing -> throwE TEVersion
   where
     th@THandle {params = THandleParams {sessionId}} = smpTHandle c
@@ -910,7 +912,7 @@ smpTHandle_ th@THandle {params} v vr thAuth encryptBlock serverInfoBytes =
             implySessId = v >= authCmdsSMPVersion,
             encryptBlock,
             serviceAuth = v >= serviceCertsSMPVersion, -- optional service signature will be encoded for all commands and responses
-            serverInfoBytes
+            serverInfo = J.eitherDecodeStrict' <$> serverInfoBytes
           }
    in (th :: THandleSMP c p) {params = params'}
 
@@ -950,7 +952,7 @@ smpTHandle c = THandle {connection = c, params}
           encryptBlock = Nothing,
           batch = True,
           serviceAuth = False,
-          serverInfoBytes = Nothing
+          serverInfo = Nothing
         }
 
 $(J.deriveJSON (sumTypeJSON id) ''HandshakeError)