Skip to content

Commit 8e86c97

Browse files
authored
servers: include supported ALPNs in server transport config (#1557)
1 parent 90e8c3a commit 8e86c97

File tree

24 files changed

+98
-97
lines changed

24 files changed

+98
-97
lines changed

src/Simplex/FileTransfer/Client.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,7 @@ import Simplex.Messaging.Protocol
5757
pattern NoEntity,
5858
)
5959
import Simplex.Messaging.Transport (ALPN, CertChainPubKey (..), HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), defaultSupportedParams)
60-
import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn)
60+
import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost)
6161
import Simplex.Messaging.Transport.HTTP2
6262
import Simplex.Messaging.Transport.HTTP2.Client
6363
import Simplex.Messaging.Transport.HTTP2.File
@@ -99,15 +99,15 @@ defaultXFTPClientConfig =
9999
XFTPClientConfig
100100
{ xftpNetworkConfig = defaultNetworkConfig,
101101
serverVRange = supportedFileServerVRange,
102-
clientALPN = Just supportedXFTPhandshakes
102+
clientALPN = Just alpnSupportedXFTPhandshakes
103103
}
104104

105105
getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> UTCTime -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
106106
getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} proxySessTs disconnected = runExceptT $ do
107107
let socksCreds = clientSocksCredentials xftpNetworkConfig proxySessTs transportSession
108108
ProtocolServer _ host port keyHash = srv
109109
useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
110-
let tcConfig = (transportClientConfig xftpNetworkConfig useHost False) {alpn = clientALPN}
110+
let tcConfig = transportClientConfig xftpNetworkConfig useHost False clientALPN
111111
http2Config = xftpHTTP2Config tcConfig config
112112
clientVar <- newTVarIO Nothing
113113
let usePort = if null port then "443" else port

src/Simplex/FileTransfer/Server.hs

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,7 @@ import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, ServerEntityStatu
6161
import Simplex.Messaging.Server.Stats
6262
import Simplex.Messaging.TMap (TMap)
6363
import qualified Simplex.Messaging.TMap as TM
64-
import Simplex.Messaging.Transport (ALPN, CertChainPubKey (..), SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..), defaultSupportedParams)
64+
import Simplex.Messaging.Transport (CertChainPubKey (..), SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..), defaultSupportedParams)
6565
import Simplex.Messaging.Transport.Buffer (trimCR)
6666
import Simplex.Messaging.Transport.HTTP2
6767
import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
@@ -92,17 +92,17 @@ data XFTPTransportRequest = XFTPTransportRequest
9292
runXFTPServer :: XFTPServerConfig -> IO ()
9393
runXFTPServer cfg = do
9494
started <- newEmptyTMVarIO
95-
runXFTPServerBlocking started cfg $ Just supportedXFTPhandshakes
95+
runXFTPServerBlocking started cfg
9696

97-
runXFTPServerBlocking :: TMVar Bool -> XFTPServerConfig -> Maybe [ALPN] -> IO ()
98-
runXFTPServerBlocking started cfg alpn_ = newXFTPServerEnv cfg >>= runReaderT (xftpServer cfg started alpn_)
97+
runXFTPServerBlocking :: TMVar Bool -> XFTPServerConfig -> IO ()
98+
runXFTPServerBlocking started cfg = newXFTPServerEnv cfg >>= runReaderT (xftpServer cfg started)
9999

100100
data Handshake
101101
= HandshakeSent C.PrivateKeyX25519
102102
| HandshakeAccepted (THandleParams XFTPVersion 'TServer)
103103

104-
xftpServer :: XFTPServerConfig -> TMVar Bool -> Maybe [ALPN] -> M ()
105-
xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration, xftpServerVRange} started alpn_ = do
104+
xftpServer :: XFTPServerConfig -> TMVar Bool -> M ()
105+
xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration, xftpServerVRange} started = do
106106
mapM_ (expireServerFiles Nothing) fileExpiration
107107
restoreServerStats
108108
raceAny_ (runServer : expireFilesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg) `finally` stopServer
@@ -116,7 +116,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
116116
env <- ask
117117
sessions <- liftIO TM.emptyIO
118118
let cleanup sessionId = atomically $ TM.delete sessionId sessions
119-
liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize defaultSupportedParams srvCreds alpn_ transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
119+
liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize defaultSupportedParams srvCreds transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
120120
reqBody <- getHTTP2Body r xftpBlockSize
121121
let v = VersionXFTP 1
122122
thServerVRange = versionToRange v

src/Simplex/FileTransfer/Server/Main.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -21,15 +21,15 @@ import Simplex.FileTransfer.Chunks
2121
import Simplex.FileTransfer.Description (FileSize (..))
2222
import Simplex.FileTransfer.Server (runXFTPServer)
2323
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration)
24-
import Simplex.FileTransfer.Transport (supportedFileServerVRange)
24+
import Simplex.FileTransfer.Transport (supportedFileServerVRange, alpnSupportedXFTPhandshakes)
2525
import qualified Simplex.Messaging.Crypto as C
2626
import Simplex.Messaging.Encoding.String
2727
import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
2828
import Simplex.Messaging.Server.CLI
2929
import Simplex.Messaging.Server.Expiration
3030
import Simplex.Messaging.Transport (simplexMQVersion)
3131
import Simplex.Messaging.Transport.Client (TransportHost (..))
32-
import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
32+
import Simplex.Messaging.Transport.Server (ServerCredentials (..), mkTransportServerConfig)
3333
import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
3434
import System.Directory (createDirectoryIfMissing, doesFileExist)
3535
import System.FilePath (combine)
@@ -189,9 +189,9 @@ xftpServerCLI cfgPath logPath = do
189189
serverStatsLogFile = combine logPath "file-server-stats.daily.log",
190190
serverStatsBackupFile = logStats $> combine logPath "file-server-stats.log",
191191
transportConfig =
192-
defaultTransportServerConfig
193-
{ logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
194-
},
192+
mkTransportServerConfig
193+
(fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini)
194+
(Just alpnSupportedXFTPhandshakes),
195195
responseDelay = 0
196196
}
197197

src/Simplex/FileTransfer/Transport.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ module Simplex.FileTransfer.Transport
1313
authCmdsXFTPVersion,
1414
blockedFilesXFTPVersion,
1515
xftpClientHandshakeStub,
16-
supportedXFTPhandshakes,
16+
alpnSupportedXFTPhandshakes,
1717
XFTPClientHandshake (..),
1818
-- xftpClientHandshake,
1919
XFTPServerHandshake (..),
@@ -104,8 +104,8 @@ supportedFileServerVRange = mkVersionRange initialXFTPVersion currentXFTPVersion
104104
xftpClientHandshakeStub :: c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> Bool -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
105105
xftpClientHandshakeStub _c _ks _keyHash _xftpVRange _proxyServer = throwE TEVersion
106106

107-
supportedXFTPhandshakes :: [ALPN]
108-
supportedXFTPhandshakes = ["xftp/1"]
107+
alpnSupportedXFTPhandshakes :: [ALPN]
108+
alpnSupportedXFTPhandshakes = ["xftp/1"]
109109

110110
data XFTPServerHandshake = XFTPServerHandshake
111111
{ xftpVersionRange :: VersionRangeXFTP,

src/Simplex/Messaging/Client.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -393,9 +393,9 @@ defaultNetworkConfig =
393393
logTLSErrors = False
394394
}
395395

396-
transportClientConfig :: NetworkConfig -> TransportHost -> Bool -> TransportClientConfig
397-
transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} host useSNI =
398-
TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, alpn = Nothing, useSNI}
396+
transportClientConfig :: NetworkConfig -> TransportHost -> Bool -> Maybe [ALPN] -> TransportClientConfig
397+
transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} host useSNI clientALPN =
398+
TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, clientALPN, useSNI}
399399
where
400400
socksProxy' = (\(SocksProxyWithAuth _ proxy) -> proxy) <$> socksProxy
401401
useSocksProxy SMAlways = socksProxy'
@@ -455,7 +455,7 @@ defaultClientConfig clientALPN useSNI serverVRange =
455455

456456
defaultSMPClientConfig :: ProtocolClientConfig SMPVersion
457457
defaultSMPClientConfig =
458-
(defaultClientConfig (Just supportedSMPHandshakes) False supportedClientSMPRelayVRange)
458+
(defaultClientConfig (Just alpnSupportedSMPHandshakes) False supportedClientSMPRelayVRange)
459459
{ defaultTransport = (show defaultSMPPort, transport @TLS),
460460
agreeSecret = True
461461
}
@@ -556,7 +556,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
556556
runClient :: (ServiceName, ATransport 'TClient) -> TransportHost -> PClient v err msg -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
557557
runClient (port', ATransport t) useHost c = do
558558
cVar <- newEmptyTMVarIO
559-
let tcConfig = (transportClientConfig networkConfig useHost useSNI) {alpn = clientALPN}
559+
let tcConfig = transportClientConfig networkConfig useHost useSNI clientALPN
560560
socksCreds = clientSocksCredentials networkConfig proxySessTs transportSession
561561
tId <-
562562
runTransportClient tcConfig socksCreds useHost port' (Just $ keyHash srv) (client t c cVar)

src/Simplex/Messaging/Notifications/Client.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ import Data.Word (Word16)
1414
import Simplex.Messaging.Client
1515
import qualified Simplex.Messaging.Crypto as C
1616
import Simplex.Messaging.Notifications.Protocol
17-
import Simplex.Messaging.Notifications.Transport (NTFVersion, supportedClientNTFVRange, supportedNTFHandshakes)
17+
import Simplex.Messaging.Notifications.Transport (NTFVersion, supportedClientNTFVRange, alpnSupportedNTFHandshakes)
1818
import Simplex.Messaging.Protocol (ErrorType, pattern NoEntity)
1919
import Simplex.Messaging.Transport (TLS, Transport (..))
2020

@@ -24,7 +24,7 @@ type NtfClientError = ProtocolClientError ErrorType
2424

2525
defaultNTFClientConfig :: ProtocolClientConfig NTFVersion
2626
defaultNTFClientConfig =
27-
(defaultClientConfig (Just supportedNTFHandshakes) False supportedClientNTFVRange)
27+
(defaultClientConfig (Just alpnSupportedNTFHandshakes) False supportedClientNTFVRange)
2828
{defaultTransport = ("443", transport @TLS)}
2929
{-# INLINE defaultNTFClientConfig #-}
3030

src/Simplex/Messaging/Notifications/Server.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -125,7 +125,7 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
125125
srvCreds <- asks tlsServerCreds
126126
serverSignKey <- either fail pure $ C.x509ToPrivate' $ snd srvCreds
127127
env <- ask
128-
liftIO $ runTransportServer started tcpPort defaultSupportedParams srvCreds (Just supportedNTFHandshakes) tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
128+
liftIO $ runTransportServer started tcpPort defaultSupportedParams srvCreds tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
129129

130130
runClient :: Transport c => C.APrivateSignKey -> TProxy c 'TServer -> c 'TServer -> M ()
131131
runClient signKey _ h = do

src/Simplex/Messaging/Notifications/Server/Main.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientCo
3737
import Simplex.Messaging.Notifications.Server.Store (newNtfSTMStore)
3838
import Simplex.Messaging.Notifications.Server.Store.Postgres (exportNtfDbStore, importNtfSTMStore, newNtfDbStore)
3939
import Simplex.Messaging.Notifications.Server.StoreLog (readWriteNtfSTMStore)
40-
import Simplex.Messaging.Notifications.Transport (supportedServerNTFVRange)
40+
import Simplex.Messaging.Notifications.Transport (alpnSupportedNTFHandshakes, supportedServerNTFVRange)
4141
import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer)
4242
import Simplex.Messaging.Server.CLI
4343
import Simplex.Messaging.Server.Env.STM (StartOptions (..))
@@ -48,7 +48,7 @@ import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..
4848
import Simplex.Messaging.Server.StoreLog (closeStoreLog)
4949
import Simplex.Messaging.Transport (ASrvTransport, simplexMQVersion)
5050
import Simplex.Messaging.Transport.Client (TransportHost (..))
51-
import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
51+
import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials (..), mkTransportServerConfig)
5252
import Simplex.Messaging.Util (eitherToMaybe, ifM, tshow)
5353
import System.Directory (createDirectoryIfMissing, doesFileExist, renameFile)
5454
import System.Exit (exitFailure)
@@ -274,9 +274,9 @@ ntfServerCLI cfgPath logPath =
274274
prometheusMetricsFile = combine logPath "ntf-server-metrics.txt",
275275
ntfServerVRange = supportedServerNTFVRange,
276276
transportConfig =
277-
defaultTransportServerConfig
278-
{ logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
279-
},
277+
mkTransportServerConfig
278+
(fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini)
279+
(Just alpnSupportedNTFHandshakes),
280280
startOptions
281281
}
282282
iniDeletedTTL ini = readIniDefault (86400 * defaultDeletedTTL) "STORE_LOG" "db_deleted_ttl" ini

src/Simplex/Messaging/Notifications/Transport.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -62,8 +62,8 @@ legacyServerNTFVRange = mkVersionRange initialNTFVersion initialNTFVersion
6262
supportedServerNTFVRange :: VersionRangeNTF
6363
supportedServerNTFVRange = mkVersionRange initialNTFVersion currentServerNTFVersion
6464

65-
supportedNTFHandshakes :: [ALPN]
66-
supportedNTFHandshakes = ["ntf/1"]
65+
alpnSupportedNTFHandshakes :: [ALPN]
66+
alpnSupportedNTFHandshakes = ["ntf/1"]
6767

6868
type THandleNTF c p = THandle NTFVersion c p
6969

src/Simplex/Messaging/Server.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -188,17 +188,17 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
188188
env <- ask
189189
liftIO $ case (httpCreds_, attachHTTP_) of
190190
(Just httpCreds, Just attachHTTP) | addHTTP ->
191-
runTransportServerState_ ss started tcpPort defaultSupportedParamsHTTPS chooseCreds (Just combinedALPNs) tCfg $ \s h ->
191+
runTransportServerState_ ss started tcpPort defaultSupportedParamsHTTPS chooseCreds tCfg {serverALPN = Just combinedALPNs} $ \s h ->
192192
case cast h of
193193
Just (TLS {tlsContext} :: TLS 'TServer) | maybe False (`elem` httpALPN) (getSessionALPN h) -> labelMyThread "https client" >> attachHTTP s tlsContext
194194
_ -> runClient srvCert srvSignKey t h `runReaderT` env
195195
where
196196
chooseCreds = maybe smpCreds (\_host -> httpCreds)
197-
combinedALPNs = supportedSMPHandshakes <> httpALPN
197+
combinedALPNs = alpnSupportedSMPHandshakes <> httpALPN
198198
httpALPN :: [ALPN]
199199
httpALPN = ["h2", "http/1.1"]
200200
_ ->
201-
runTransportServerState ss started tcpPort defaultSupportedParams smpCreds (Just supportedSMPHandshakes) tCfg $ \h -> runClient srvCert srvSignKey t h `runReaderT` env
201+
runTransportServerState ss started tcpPort defaultSupportedParams smpCreds tCfg $ \h -> runClient srvCert srvSignKey t h `runReaderT` env
202202

203203
sigIntHandlerThread :: M s ()
204204
sigIntHandlerThread = do

0 commit comments

Comments
 (0)