diff --git a/src/Simplex/Messaging/Transport/Client.hs b/src/Simplex/Messaging/Transport/Client.hs index 5d85e7aab..42be5125b 100644 --- a/src/Simplex/Messaging/Transport/Client.hs +++ b/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) +import Control.Logger.Simple (logError, logWarn) import Control.Monad import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Attoparsec.ByteString.Char8 as A @@ -181,7 +181,9 @@ runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tls <- set CHContext $ connectTLS (Just hostName) tCfg clientParams sock chain <- takePeerCertChain serverCert sent <- readIORef clientCredsSent - client =<< set CHTransport (getTransportConnection tCfg sent chain tls) + c <- set CHTransport (getTransportConnection tCfg sent chain tls) + logWarn $ "ALPN: client negotiated " <> tshow (getSessionALPN c) + client c where closeConn = readIORef >=> mapM_ (\c -> E.uninterruptibleMask_ $ closeConn_ c `catchAll_` pure ()) closeConn_ = \case @@ -294,7 +296,7 @@ mkTLSClientParams supported caStore_ host port cafp_ clientCreds_ clientCredsSen def { T.onServerCertificate = onServerCert, T.onCertificateRequest = onCertRequest, - T.onSuggestALPN = pure alpn_ + T.onSuggestALPN = alpn_ <$ logWarn ("ALPN: client offering " <> tshow alpn_) }, T.clientSupported = supported } diff --git a/src/Simplex/Messaging/Transport/Server.hs b/src/Simplex/Messaging/Transport/Server.hs index cdfc300b7..8ef8f7305 100644 --- a/src/Simplex/Messaging/Transport/Server.hs +++ b/src/Simplex/Messaging/Transport/Server.hs @@ -139,6 +139,7 @@ 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 @@ -266,7 +267,13 @@ supportedTLSServerParams serverSupported TLSServerCredential {credential, sniCre Just sniCred -> \case Nothing -> pure $ T.Credentials [credential] Just _host -> T.Credentials [sniCred] <$ atomically (writeTVar sniCredUsed True), - T.onALPNClientSuggest = (\alpn -> pure . fromMaybe "" . find (`elem` alpn)) <$> alpn_ + 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.serverSupported = serverSupported }