servers: fix server pages when source code is not specified, include commit SHA in printed version and in web page. (#1608)

* smp server: fix server pages when source code is not specified * servers: include git commit in version * flexible alpn * fix test * fix ghc 8.10.7 build
2026-03-31 14:06:07 +00:00 · 2025-08-23 19:59:00 +01:00
parent a2d35281b2
commit e48bedeaf2
20 changed files with 124 additions and 61 deletions
--- a/apps/smp-server/static/index.html
+++ b/apps/smp-server/static/index.html
@@ -223,11 +223,14 @@
            <table id="public-info">
              <tr class="text-grey-black dark:text-white text-base">
                <td>Server version:</td>
-                <td>${version}</td>
+                <td>${version}<x-commit> / <a href="${commitSourceCode}/commit/${commit}" target="_blank">${shortCommit}</a></x-commit></td>
              </tr>
              <tr class="text-grey-black dark:text-white text-base">
                <td>Source code:</td>
-                <td><a href="${sourceCode}" target="_blank">${sourceCode}</a></td>
+                <td>
+                  <x-sourceCode><a href="${sourceCode}" target="_blank">${sourceCode}</a></x-sourceCode>
+                  <x-noSourceCode>add to smp-server.ini (required by <a href="https://github.com/simplex-chat/simplexmq/blob/stable/LICENSE" target="_blank">AGPLv3</a>)</x-noSourceCode>
+                </td>
              </tr>
              <x-website>
                <tr class="text-grey-black dark:text-white text-base">
--- a/apps/smp-server/web/Static.hs
+++ b/apps/smp-server/web/Static.hs
@@ -12,6 +12,7 @@ import Data.Char (toUpper)
 import Data.IORef (readIORef)
 import Data.Maybe (fromMaybe)
 import Data.String (fromString)
+import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Network.Socket (getPeerName)
 import Network.Wai (Application, Request (..))
@@ -22,8 +23,9 @@ import qualified Network.Wai.Handler.Warp.Internal as WI
 import qualified Network.Wai.Handler.WarpTLS as WT
 import Simplex.Messaging.Encoding.String (strEncode)
 import Simplex.Messaging.Server (AttachHTTP)
+import Simplex.Messaging.Server.CLI (simplexmqCommit)
 import Simplex.Messaging.Server.Information
-import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..))
+import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..), simplexmqSource)
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util (tshow)
@@ -117,7 +119,7 @@ generateSite si onionHost sitePath = do
 serverInformation :: ServerInformation -> Maybe TransportHost -> ByteString
 serverInformation ServerInformation {config, information} onionHost = render E.indexHtml substs
  where
-    substs = substConfig <> maybe [] substInfo information <> [("onionHost", strEncode <$> onionHost)]
+    substs = substConfig <> substInfo <> [("onionHost", strEncode <$> onionHost)]
    substConfig =
      [ ( "persistence",
          Just $ case persistence config of
@@ -132,7 +134,7 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
      ]
    yesNo True = "Yes"
    yesNo False = "No"
-    substInfo spi =
+    substInfo =
      concat
        [ basic,
          maybe [("usageConditions", Nothing), ("usageAmendments", Nothing)] conds (usageConditions spi),
@@ -144,10 +146,16 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
        ]
      where
        basic =
-          [ ("sourceCode", Just . encodeUtf8 $ sourceCode spi),
+          [ ("sourceCode", if T.null sc then Nothing else Just (encodeUtf8 sc)),
+            ("noSourceCode", if T.null sc then Just "none" else Nothing),
            ("version", Just $ B.pack simplexMQVersion),
+            ("commitSourceCode", Just $ encodeUtf8 $ maybe (T.pack simplexmqSource) sourceCode information),
+            ("shortCommit", Just $ B.pack $ take 7 simplexmqCommit),
+            ("commit", Just $ B.pack simplexmqCommit),
            ("website", encodeUtf8 <$> website spi)
          ]
+        spi = fromMaybe (emptyServerInfo "") information
+        sc = sourceCode spi
        conds ServerConditions {conditions, amendments} =
          [ ("usageConditions", Just $ encodeUtf8 conditions),
            ("usageAmendments", encodeUtf8 <$> amendments)
@@ -229,8 +237,8 @@ section_ label content' src =
        (inside, next') ->
          let next = B.drop (B.length endMarker) next'
           in case content' of
-                Nothing -> before <> next -- collapse section
-                Just content -> before <> item_ label content inside <> section_ label content' next
+                Just content | not (B.null content) -> before <> item_ label content inside <> section_ label content' next
+                _ -> before <> next -- collapse section
  where
    startMarker = "<x-" <> label <> ">"
    endMarker = "</x-" <> label <> ">"
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -234,6 +234,7 @@ library
          Simplex.Messaging.Server.Env.STM
          Simplex.Messaging.Server.Information
          Simplex.Messaging.Server.Main
+          Simplex.Messaging.Server.Main.GitCommit
          Simplex.Messaging.Server.Main.Init
          Simplex.Messaging.Server.MsgStore
          Simplex.Messaging.Server.MsgStore.Journal
@@ -354,10 +355,12 @@ library
  if impl(ghc >= 9.6.2)
    build-depends:
        bytestring ==0.11.*
+      , template-haskell ==2.20.*
      , text >=2.0.1 && <2.2
  if impl(ghc < 9.6.2)
    build-depends:
        bytestring ==0.10.*
+      , template-haskell ==2.16.*
      , text >=1.2.3.0 && <1.3

 executable ntf-server
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -31,6 +31,7 @@ import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Client as H
+import Network.Socket (HostName)
 import Simplex.FileTransfer.Chunks
 import Simplex.FileTransfer.Protocol
 import Simplex.FileTransfer.Transport
@@ -45,6 +46,7 @@ import Simplex.Messaging.Client
    transportClientConfig,
    clientSocksCredentials,
    unexpectedResponse,
+    useWebPort,
  )
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
@@ -104,12 +106,13 @@ defaultXFTPClientConfig =
      clientALPN = Just alpnSupportedXFTPhandshakes
    }

-getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> UTCTime -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
-getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} proxySessTs disconnected = runExceptT $ do
+getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> [HostName] -> UTCTime -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
+getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} presetDomains proxySessTs disconnected = runExceptT $ do
  let socksCreds = clientSocksCredentials xftpNetworkConfig proxySessTs transportSession
      ProtocolServer _ host port keyHash = srv
+      useALPN = if useWebPort xftpNetworkConfig presetDomains srv then Just [httpALPN11] else clientALPN
  useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
-  let tcConfig = transportClientConfig xftpNetworkConfig NRMBackground useHost False clientALPN
+  let tcConfig = transportClientConfig xftpNetworkConfig NRMBackground useHost False useALPN
      http2Config = xftpHTTP2Config tcConfig config
  clientVar <- newTVarIO Nothing
  let usePort = if null port then "443" else port
@@ -121,7 +124,8 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
      thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
  logDebug $ "Client negotiated handshake protocol: " <> tshow sessionALPN
  thParams@THandleParams {thVersion} <- case sessionALPN of
-    Just "xftp/1" -> xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
+    Just alpn | alpn == xftpALPNv1 || alpn == httpALPN11 ->
+      xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
    _ -> pure thParams0
  logDebug $ "Client negotiated protocol: " <> tshow thVersion
  let c = XFTPClient {http2Client, thParams, transportSession, config}
--- a/src/Simplex/FileTransfer/Client/Agent.hs
+++ b/src/Simplex/FileTransfer/Client/Agent.hs
@@ -71,7 +71,7 @@ getXFTPServerClient XFTPClientAgent {xftpClients, startedAt, config} srv = do
    connectClient =
      ExceptT $
        first (XFTPClientAgentError srv)
-          <$> getXFTPClient (1, srv, Nothing) (xftpConfig config) startedAt clientDisconnected
+          <$> getXFTPClient (1, srv, Nothing) (xftpConfig config) [] startedAt clientDisconnected

    clientDisconnected :: XFTPClient -> IO ()
    clientDisconnected _ = do
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -133,7 +133,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
            req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse}
        flip runReaderT env $ case sessionALPN of
          Nothing -> processRequest req0
-          Just "xftp/1" ->
+          Just alpn | alpn == xftpALPNv1 || alpn == httpALPN11 ->
            xftpServerHandshakeV1 chain signKey sessions req0 >>= \case
              Nothing -> pure () -- handshake response sent
              Just thParams -> processRequest req0 {thParams} -- proceed with new version (XXX: may as well switch the request handler here)
--- a/src/Simplex/FileTransfer/Server/Main.hs
+++ b/src/Simplex/FileTransfer/Server/Main.hs
@@ -27,8 +27,8 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Transport.HTTP2 (httpALPN)
 import Simplex.Messaging.Transport.Server (ServerCredentials (..), mkTransportServerConfig)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
@@ -60,7 +60,7 @@ xftpServerCLI cfgPath logPath = do
      putStrLn "Deleted configuration and log files"
  where
    iniFile = combine cfgPath "file-server.ini"
-    serverVersion = "SimpleX XFTP server v" <> simplexMQVersion
+    serverVersion = "SimpleX XFTP server v" <> simplexmqVersionCommit
    defaultServerPort = "443"
    executableName = "file-server"
    storeLogFilePath = combine logPath "file-server-store.log"
@@ -196,7 +196,7 @@ xftpServerCLI cfgPath logPath = do
              transportConfig =
                mkTransportServerConfig
                  (fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini)
-                  (Just alpnSupportedXFTPhandshakes)
+                  (Just $ alpnSupportedXFTPhandshakes <> httpALPN)
                  False,
              responseDelay = 0
            }
--- a/src/Simplex/FileTransfer/Transport.hs
+++ b/src/Simplex/FileTransfer/Transport.hs
@@ -14,6 +14,7 @@ module Simplex.FileTransfer.Transport
    blockedFilesXFTPVersion,
    xftpClientHandshakeStub,
    alpnSupportedXFTPhandshakes,
+    xftpALPNv1,
    XFTPClientHandshake (..),
    -- xftpClientHandshake,
    XFTPServerHandshake (..),
@@ -105,7 +106,10 @@ xftpClientHandshakeStub :: c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> V
 xftpClientHandshakeStub _c _ks _keyHash _xftpVRange _proxyServer _serviceKeys = throwE TEVersion

 alpnSupportedXFTPhandshakes :: [ALPN]
-alpnSupportedXFTPhandshakes = ["xftp/1"]
+alpnSupportedXFTPhandshakes = [xftpALPNv1]
+
+xftpALPNv1 :: ALPN
+xftpALPNv1 = "xftp/1"

 data XFTPServerHandshake = XFTPServerHandshake
  { xftpVersionRange :: VersionRangeXFTP,
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -330,7 +330,7 @@ data AgentClient = AgentClient
    xftpServers :: TMap UserId (UserServers 'PXFTP),
    xftpClients :: TMap XFTPTransportSession XFTPClientVar,
    useNetworkConfig :: TVar (NetworkConfig, NetworkConfig), -- (slow, fast) networks
-    presetSMPDomains :: [HostName],
+    presetDomains :: [HostName],
    userNetworkInfo :: TVar UserNetworkInfo,
    userNetworkUpdated :: TVar (Maybe UTCTime),
    subscrConns :: TVar (Set ConnId),
@@ -537,7 +537,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg, presetDomai
        xftpServers,
        xftpClients,
        useNetworkConfig,
-        presetSMPDomains = presetDomains,
+        presetDomains,
        userNetworkInfo,
        userNetworkUpdated,
        subscrConns,
@@ -686,7 +686,7 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
        Nothing -> Left $ BROKER (B.unpack $ strEncode srv) TIMEOUT

 smpConnectClient :: AgentClient -> NetworkRequestMode -> SMPTransportSession -> TMap SMPServer ProxiedRelayVar -> SMPClientVar -> AM SMPConnectedClient
-smpConnectClient c@AgentClient {smpClients, msgQ, proxySessTs} nm tSess@(_, srv, _) prs v =
+smpConnectClient c@AgentClient {smpClients, msgQ, proxySessTs, presetDomains} nm tSess@(_, srv, _) prs v =
  newProtocolClient c tSess smpClients connectClient v
    `catchAgentError` \e -> lift (resubscribeSMPSession c tSess) >> throwE e
  where
@@ -697,7 +697,7 @@ smpConnectClient c@AgentClient {smpClients, msgQ, proxySessTs} nm tSess@(_, srv,
      env <- ask
      liftError (protocolClientError SMP $ B.unpack $ strEncode srv) $ do
        ts <- readTVarIO proxySessTs
-        smp <- ExceptT $ getProtocolClient g nm tSess cfg (presetSMPDomains c) (Just msgQ) ts $ smpClientDisconnected c tSess env v' prs
+        smp <- ExceptT $ getProtocolClient g nm tSess cfg presetDomains (Just msgQ) ts $ smpClientDisconnected c tSess env v' prs
        pure SMPConnectedClient {connectedClient = smp, proxiedRelays = prs}

 smpClientDisconnected :: AgentClient -> SMPTransportSession -> Env -> SMPClientVar -> TMap SMPServer ProxiedRelayVar -> SMPClient -> IO ()
@@ -786,7 +786,7 @@ reconnectSMPClient c tSess@(_, srv, _) qs = handleNotify $ do
    notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, AEvt (sAEntity @e) cmd)

 getNtfServerClient :: AgentClient -> NetworkRequestMode -> NtfTransportSession -> AM NtfClient
-getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs} nm tSess@(_, srv, _) = do
+getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs, presetDomains} nm tSess@(_, srv, _) = do
  unlessM (readTVarIO active) $ throwE INACTIVE
  ts <- liftIO getCurrentTime
  atomically (getSessVar workerSeq tSess ntfClients ts)
@@ -800,7 +800,7 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs} nm
      g <- asks random
      ts <- readTVarIO proxySessTs
      liftError' (protocolClientError NTF $ B.unpack $ strEncode srv) $
-        getProtocolClient g nm tSess cfg [] Nothing ts $
+        getProtocolClient g nm tSess cfg presetDomains Nothing ts $
          clientDisconnected v

    clientDisconnected :: NtfClientVar -> NtfClient -> IO ()
@@ -810,7 +810,7 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs} nm
      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv

 getXFTPServerClient :: AgentClient -> XFTPTransportSession -> AM XFTPClient
-getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq, proxySessTs} tSess@(_, srv, _) = do
+getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq, proxySessTs, presetDomains} tSess@(_, srv, _) = do
  unlessM (readTVarIO active) $ throwE INACTIVE
  ts <- liftIO getCurrentTime
  atomically (getSessVar workerSeq tSess xftpClients ts)
@@ -824,7 +824,7 @@ getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq, proxySessTs}
      xftpNetworkConfig <- getNetworkConfig c
      ts <- readTVarIO proxySessTs
      liftError' (protocolClientError XFTP $ B.unpack $ strEncode srv) $
-        X.getXFTPClient tSess cfg {xftpNetworkConfig} ts $
+        X.getXFTPClient tSess cfg {xftpNetworkConfig} presetDomains ts $
          clientDisconnected v

    clientDisconnected :: XFTPClientVar -> XFTPClient -> IO ()
@@ -1227,7 +1227,7 @@ data ProtocolTestFailure = ProtocolTestFailure
  deriving (Eq, Show)

 runSMPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> SMPServerWithAuth -> AM' (Maybe ProtocolTestFailure)
-runSMPServerTest c nm userId (ProtoServerWithAuth srv auth) = do
+runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth srv auth) = do
  cfg <- getClientConfig c smpCfg
  C.AuthAlg ra <- asks $ rcvAuthAlg . config
  C.AuthAlg sa <- asks $ sndAuthAlg . config
@@ -1235,7 +1235,7 @@ runSMPServerTest c nm userId (ProtoServerWithAuth srv auth) = do
  liftIO $ do
    let tSess = (userId, srv, Nothing)
    ts <- readTVarIO $ proxySessTs c
-    getProtocolClient g nm tSess cfg (presetSMPDomains c) Nothing ts (\_ -> pure ()) >>= \case
+    getProtocolClient g nm tSess cfg presetDomains Nothing ts (\_ -> pure ()) >>= \case
      Right smp -> do
        rKeys@(_, rpKey) <- atomically $ C.generateAuthKeyPair ra g
        (sKey, spKey) <- atomically $ C.generateAuthKeyPair sa g
@@ -1256,7 +1256,7 @@ runSMPServerTest c nm userId (ProtoServerWithAuth srv auth) = do
    testErr step = ProtocolTestFailure step . protocolClientError SMP addr

 runXFTPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> XFTPServerWithAuth -> AM' (Maybe ProtocolTestFailure)
-runXFTPServerTest c nm userId (ProtoServerWithAuth srv auth) = do
+runXFTPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth srv auth) = do
  cfg <- asks $ xftpCfg . config
  g <- asks random
  xftpNetworkConfig <- getNetworkConfig c
@@ -1266,7 +1266,7 @@ runXFTPServerTest c nm userId (ProtoServerWithAuth srv auth) = do
  liftIO $ do
    let tSess = (userId, srv, Nothing)
    ts <- readTVarIO $ proxySessTs c
-    X.getXFTPClient tSess cfg {xftpNetworkConfig} ts (\_ -> pure ()) >>= \case
+    X.getXFTPClient tSess cfg {xftpNetworkConfig} presetDomains ts (\_ -> pure ()) >>= \case
      Right xftp -> withTestChunk filePath $ do
        (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
        (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -1304,14 +1304,14 @@ runXFTPServerTest c nm userId (ProtoServerWithAuth srv auth) = do
    createTestChunk fp = B.writeFile fp =<< atomically . C.randomBytes chSize =<< C.newRandom

 runNTFServerTest :: AgentClient -> NetworkRequestMode -> UserId -> NtfServerWithAuth -> AM' (Maybe ProtocolTestFailure)
-runNTFServerTest c nm userId (ProtoServerWithAuth srv _) = do
+runNTFServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth srv _) = do
  cfg <- getClientConfig c ntfCfg
  C.AuthAlg a <- asks $ rcvAuthAlg . config
  g <- asks random
  liftIO $ do
    let tSess = (userId, srv, Nothing)
    ts <- readTVarIO $ proxySessTs c
-    getProtocolClient g nm tSess cfg [] Nothing ts (\_ -> pure ()) >>= \case
+    getProtocolClient g nm tSess cfg presetDomains Nothing ts (\_ -> pure ()) >>= \case
      Right ntf -> do
        (nKey, npKey) <- atomically $ C.generateAuthKeyPair a g
        (dhKey, _) <- atomically $ C.generateKeyPair g
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -38,6 +38,7 @@ module Simplex.Messaging.Client
    protocolClientServer',
    transportHost',
    transportSession',
+    useWebPort,

    -- * SMP protocol command functions
    createSMPQueue,
@@ -160,6 +161,7 @@ import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client (SocksAuth (..), SocksProxyWithAuth (..), TransportClientConfig (..), TransportHost (..), defaultSMPPort, runTransportClient)
+import Simplex.Messaging.Transport.HTTP2 (httpALPN11)
 import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
@@ -560,7 +562,7 @@ getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qS
        `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
    Left e -> pure $ Left e
  where
-    NetworkConfig {smpWebPortServers, tcpConnectTimeout, tcpTimeout, smpPingInterval} = networkConfig
+    NetworkConfig {tcpConnectTimeout, tcpTimeout, smpPingInterval} = networkConfig
    mkProtocolClient :: TransportHost -> UTCTime -> IO (PClient v err msg)
    mkProtocolClient transportHost ts = do
      connected <- newTVarIO False
@@ -591,7 +593,7 @@ getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qS
    runClient :: (ServiceName, ATransport 'TClient) -> TransportHost -> PClient v err msg -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
    runClient (port', ATransport t) useHost c = do
      cVar <- newEmptyTMVarIO
-      let tcConfig = (transportClientConfig networkConfig nm useHost useSNI clientALPN) {clientCredentials = serviceCreds <$> serviceCredentials}
+      let tcConfig = (transportClientConfig networkConfig nm useHost useSNI useALPN) {clientCredentials = serviceCreds <$> serviceCredentials}
          socksCreds = clientSocksCredentials networkConfig proxySessTs transportSession
      tId <-
        runTransportClient tcConfig socksCreds useHost port' (Just $ keyHash srv) (client t c cVar)
@@ -605,16 +607,14 @@ getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qS
    useTransport :: (ServiceName, ATransport 'TClient)
    useTransport = case port srv of
      "" -> case protocolTypeI @(ProtoType msg) of
-        SPSMP | smpWebPort -> ("443", transport @TLS)
+        SPSMP | web -> ("443", transport @TLS)
        _ -> defaultTransport cfg
      p -> (p, transport @TLS)
-      where
-        smpWebPort = case smpWebPortServers of
-          SWPAll -> True
-          SWPPreset -> case srv of
-            ProtocolServer {host = THDomainName h :| _} -> any (`isSuffixOf` h) presetDomains
-            _ -> False
-          SWPOff -> False
+
+    useALPN :: Maybe [ALPN]
+    useALPN = if web then Just [httpALPN11] else clientALPN
+
+    web = useWebPort networkConfig presetDomains srv

    client :: forall c. Transport c => TProxy c 'TClient -> PClient v err msg -> TMVar (Either (ProtocolClientError err) (ProtocolClient v err msg)) -> c 'TClient -> IO ()
    client _ c cVar h = do
@@ -709,6 +709,14 @@ getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qS
              Left e -> logError $ "SMP client error: " <> tshow e
              Right _ -> logWarn "SMP client unprocessed event"

+useWebPort :: NetworkConfig -> [HostName] -> ProtocolServer p -> Bool
+useWebPort cfg presetDomains srv = case smpWebPortServers cfg of
+  SWPAll -> True
+  SWPPreset -> case srv of
+    ProtocolServer {host = THDomainName h :| _} -> any (`isSuffixOf` h) presetDomains
+    _ -> False
+  SWPOff -> False
+
 unexpectedResponse :: Show r => r -> ProtocolClientError err
 unexpectedResponse = PCEUnexpectedResponse . B.pack . take 32 . show

--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -46,8 +46,9 @@ import Simplex.Messaging.Server.Main (strParse)
 import Simplex.Messaging.Server.Main.Init (iniDbOpts)
 import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
 import Simplex.Messaging.Server.StoreLog (closeStoreLog)
-import Simplex.Messaging.Transport (ASrvTransport, simplexMQVersion)
+import Simplex.Messaging.Transport (ASrvTransport)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Transport.HTTP2 (httpALPN)
 import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials (..), mkTransportServerConfig)
 import Simplex.Messaging.Util (eitherToMaybe, ifM, tshow)
 import System.Directory (createDirectoryIfMissing, doesFileExist, renameFile)
@@ -136,7 +137,7 @@ ntfServerCLI cfgPath logPath =
            (putStrLn ("Store log file " <> storeLogFile <> " not found") >> exitFailure)
        Nothing -> putStrLn "Store log disabled, see `[STORE_LOG] enable`" >> exitFailure
    iniFile = combine cfgPath "ntf-server.ini"
-    serverVersion = "SMP notifications server v" <> simplexMQVersion
+    serverVersion = "SMP notifications server v" <> simplexmqVersionCommit
    defaultServerPort = "443"
    executableName = "ntf-server"
    storeLogFilePath = combine logPath "ntf-server-store.log"
@@ -283,7 +284,7 @@ ntfServerCLI cfgPath logPath =
              transportConfig =
                mkTransportServerConfig
                  (fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini)
-                  (Just alpnSupportedNTFHandshakes)
+                  (Just $ alpnSupportedNTFHandshakes <> httpALPN)
                  False,
              startOptions
            }
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -203,15 +203,12 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
      env <- ask
      liftIO $ case (httpCreds_, attachHTTP_) of
        (Just httpCreds, Just attachHTTP) | addHTTP ->
-          runTransportServerState_ ss started tcpPort defaultSupportedParamsHTTPS combinedCreds tCfg {serverALPN = Just combinedALPNs} $ \s (sniUsed, h) ->
+          runTransportServerState_ ss started tcpPort defaultSupportedParamsHTTPS combinedCreds tCfg $ \s (sniUsed, h) ->
            case cast h of
              Just (TLS {tlsContext} :: TLS 'TServer) | sniUsed -> labelMyThread "https client" >> attachHTTP s tlsContext
              _ -> runClient srvCert srvSignKey t h `runReaderT` env
          where
            combinedCreds = TLSServerCredential {credential = smpCreds, sniCredential = Just httpCreds}
-            combinedALPNs = alpnSupportedSMPHandshakes <> httpALPN
-            httpALPN :: [ALPN]
-            httpALPN = ["h2", "http/1.1"]
        _ ->
          runTransportServerState ss started tcpPort defaultSupportedParams smpCreds tCfg $ \h -> runClient srvCert srvSignKey t h `runReaderT` env

--- a/src/Simplex/Messaging/Server/CLI.hs
+++ b/src/Simplex/Messaging/Server/CLI.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}

@@ -33,8 +34,9 @@ import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI)
 import Simplex.Messaging.Server.Env.STM (ServerStoreCfg (..), StartOptions (..), StorePaths (..))
+import Simplex.Messaging.Server.Main.GitCommit
 import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
-import Simplex.Messaging.Transport (ASrvTransport, ATransport (..), TLS, Transport (..))
+import Simplex.Messaging.Transport (ASrvTransport, ATransport (..), TLS, Transport (..), simplexMQVersion)
 import Simplex.Messaging.Transport.Server (AddHTTP, loadFileFingerprint)
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (eitherToMaybe, whenM)
@@ -97,6 +99,12 @@ getCliCommand' cmdP version =
  where
    versionOption = infoOption version (long "version" <> short 'v' <> help "Show version")

+simplexmqVersionCommit :: String
+simplexmqVersionCommit = simplexMQVersion <> " / " <> take 7 simplexmqCommit
+
+simplexmqCommit :: String
+simplexmqCommit = $(gitCommit)
+
 createServerX509 :: FilePath -> X509Config -> IO ByteString
 createServerX509 = createServerX509_ True

--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -56,8 +56,9 @@ import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgStore (..), QStoreCf
 import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), SQSType (..), SMSType (..), newMsgStore)
 import Simplex.Messaging.Server.QueueStore.Postgres.Config
 import Simplex.Messaging.Server.StoreLog.ReadWrite (readQueueStore)
-import Simplex.Messaging.Transport (simplexMQVersion, supportedProxyClientSMPRelayVRange, alpnSupportedSMPHandshakes, supportedServerSMPRelayVRange)
+import Simplex.Messaging.Transport (supportedProxyClientSMPRelayVRange, alpnSupportedSMPHandshakes, supportedServerSMPRelayVRange)
 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 System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
@@ -234,7 +235,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
            (putStrLn ("Store log file " <> storeLogFile <> " not found") >> exitFailure)
        Nothing -> putStrLn "Store log disabled, see `[STORE_LOG] enable`" >> exitFailure
    iniFile = combine cfgPath "smp-server.ini"
-    serverVersion = "SMP server v" <> simplexMQVersion
+    serverVersion = "SMP server v" <> simplexmqVersionCommit
    executableName = "smp-server"
    storeLogFilePath = combine logPath "smp-server-store.log"
    storeMsgsFilePath = combine logPath "smp-server-messages.log"
@@ -450,7 +451,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
              transportConfig =
                mkTransportServerConfig
                  (fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini)
-                  (Just alpnSupportedSMPHandshakes)
+                  (Just $ alpnSupportedSMPHandshakes <> httpALPN)
                  (fromMaybe True $ iniOnOff "TRANSPORT" "accept_service_credentials" ini), -- TODO [certs] remove this option
              controlPort = eitherToMaybe $ T.unpack <$> lookupValue "TRANSPORT" "control_port" ini,
              smpAgentCfg =
@@ -808,7 +809,7 @@ cliCommandP cfgPath logPath iniFile =
            sourceCode = T.pack <$> sourceCode,
            serverInfo =
              ServerPublicInfo
-                { sourceCode = T.pack simplexmqSource,
+                { sourceCode = T.pack $ fromMaybe simplexmqSource sourceCode,
                  usageConditions = Nothing,
                  operator = fst operator_,
                  website,
--- a/src/Simplex/Messaging/Server/Main/GitCommit.hs
+++ b/src/Simplex/Messaging/Server/Main/GitCommit.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Messaging.Server.Main.GitCommit where
+
+import Language.Haskell.TH
+import System.Process
+import Control.Exception
+import System.Exit
+
+gitCommit :: Q Exp
+gitCommit = stringE . commit =<< runIO (try $ readProcessWithExitCode "git" ["rev-parse", "HEAD"] "")
+  where
+    commit :: Either SomeException (ExitCode, String, String) -> String
+    commit = \case
+      Right (ExitSuccess, out, _) -> take 40 out
+      _ -> ""
--- a/src/Simplex/Messaging/Transport/HTTP2.hs
+++ b/src/Simplex/Messaging/Transport/HTTP2.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}

 module Simplex.Messaging.Transport.HTTP2 where

@@ -15,7 +16,7 @@ import qualified Network.HTTP2.Server as HS
 import Network.Socket (SockAddr (..))
 import qualified Network.TLS as T
 import qualified Network.TLS.Extra as TE
-import Simplex.Messaging.Transport (TLS, Transport (cGet, cPut))
+import Simplex.Messaging.Transport (ALPN, TLS, Transport (cGet, cPut))
 import Simplex.Messaging.Transport.Buffer
 import qualified System.TimeManager as TI

@@ -81,3 +82,9 @@ getHTTP2Body r n = do
      -- TODO check bodySize once it is set
      bodyPart = if B.length bodyHead == n then Just getPart else Nothing
  pure HTTP2Body {bodyHead, bodySize, bodyPart, bodyBuffer}
+
+httpALPN :: [ALPN]
+httpALPN = ["h2", "http/1.1"]
+
+httpALPN11 :: ALPN
+httpALPN11 = "http/1.1"
--- a/tests/AgentTests/ServerChoice.hs
+++ b/tests/AgentTests/ServerChoice.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}

--- a/tests/CLITests.hs
+++ b/tests/CLITests.hs
@@ -23,8 +23,9 @@ import qualified Network.HTTP.Client as H1
 import qualified Network.HTTP2.Client as H2
 import Simplex.FileTransfer.Server.Main (xftpServerCLI)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Server.CLI (simplexmqVersionCommit)
 import Simplex.Messaging.Server.Main (smpServerCLI, smpServerCLI_)
-import Simplex.Messaging.Transport (TLS (..), TransportPeer (..), defaultSupportedParams, defaultSupportedParamsHTTPS, simplexMQVersion, supportedClientSMPRelayVRange)
+import Simplex.Messaging.Transport (TLS (..), TransportPeer (..), defaultSupportedParams, defaultSupportedParamsHTTPS, supportedClientSMPRelayVRange)
 import Simplex.Messaging.Transport.Client (TransportClientConfig (..), defaultTransportClientConfig, runTLSTransportClient, smpClientHandshake)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HC
@@ -108,7 +109,7 @@ smpServerTest storeLog basicAuth = do
  doesFileExist (cfgPath <> "/ca.key") `shouldReturn` True
  -- start
  r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` smpServerCLI cfgPath logPath) `catchAll_` pure (Just ()))
-  r `shouldContain` ["SMP server v" <> simplexMQVersion]
+  r `shouldContain` ["SMP server v" <> simplexmqVersionCommit]
  r `shouldContain` (if storeLog then ["Store log: " <> logPath <> "/smp-server-store.log"] else ["Store log disabled."])
  r `shouldContain` ["Serving SMP protocol on port 5223 (TLS)...", "Serving SMP protocol on port 443 (TLS)...", "Serving static site on port 443 (TLS)..."]
  r `shouldContain` ["expiring clients inactive for 21600 seconds every 3600 seconds"]
@@ -216,7 +217,7 @@ ntfServerTest storeLog = do
  lookupValue "TRANSPORT" "websockets" ini `shouldBe` Right "off"
  doesFileExist (ntfCfgPath <> "/ca.key") `shouldReturn` True
  r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` ntfServerCLI ntfCfgPath ntfLogPath) `catchAll_` pure (Just ()))
-  r `shouldContain` ["SMP notifications server v" <> simplexMQVersion]
+  r `shouldContain` ["SMP notifications server v" <> simplexmqVersionCommit]
  r `shouldContain` (if storeLog then ["Store log: " <> ntfLogPath <> "/ntf-server-store.log"] else ["Store log disabled."])
  r `shouldContain` ["Serving NTF protocol on port 443 (TLS)..."]
  capture_ (withStdin "Y" . withArgs ["delete"] $ ntfServerCLI ntfCfgPath ntfLogPath)
@@ -234,7 +235,7 @@ xftpServerTest storeLog = do
  lookupValue "TRANSPORT" "port" ini `shouldBe` Right "443"
  doesFileExist (fileCfgPath <> "/ca.key") `shouldReturn` True
  r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` xftpServerCLI fileCfgPath fileLogPath) `catchAll_` pure (Just ()))
-  r `shouldContain` ["SimpleX XFTP server v" <> simplexMQVersion]
+  r `shouldContain` ["SimpleX XFTP server v" <> simplexmqVersionCommit]
  r `shouldContain` (if storeLog then ["Store log: " <> fileLogPath <> "/file-server-store.log"] else ["Store log disabled."])
  r `shouldContain` ["Listening on port 443..."]
  capture_ (withStdin "Y" . withArgs ["delete"] $ xftpServerCLI fileCfgPath fileLogPath)
--- a/tests/XFTPClient.hs
+++ b/tests/XFTPClient.hs
@@ -145,6 +145,6 @@ testXFTPClient = testXFTPClientWith testXFTPClientConfig
 testXFTPClientWith :: HasCallStack => XFTPClientConfig -> (HasCallStack => XFTPClient -> IO a) -> IO a
 testXFTPClientWith cfg client = do
  ts <- getCurrentTime
-  getXFTPClient (1, testXFTPServer, Nothing) cfg ts (\_ -> pure ()) >>= \case
+  getXFTPClient (1, testXFTPServer, Nothing) cfg [] ts (\_ -> pure ()) >>= \case
    Right c -> client c
    Left e -> error $ show e
--- a/tests/XFTPServerTests.hs
+++ b/tests/XFTPServerTests.hs
@@ -223,7 +223,7 @@ testInactiveClientExpiration :: Expectation
 testInactiveClientExpiration = withXFTPServerCfg testXFTPServerConfig {inactiveClientExpiration} $ \_ -> runRight_ $ do
  disconnected <- newEmptyTMVarIO
  ts <- liftIO getCurrentTime
-  c <- ExceptT $ getXFTPClient (1, testXFTPServer, Nothing) testXFTPClientConfig ts (\_ -> atomically $ putTMVar disconnected ())
+  c <- ExceptT $ getXFTPClient (1, testXFTPServer, Nothing) testXFTPClientConfig [] ts (\_ -> atomically $ putTMVar disconnected ())
  pingXFTP c
  liftIO $ do
    threadDelay 100000