log alpn in client and server

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
     }

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
     }