dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-07-31 18:11:07 +00:00
Code Issues Packages Projects Releases Wiki Activity

servers: refactor TLS credentials (#1326)

Browse Source 
* servers: refactor TLS credentials

* provide server credentials in SNI hook

* determine TLS server params dynamically, when starting the server

* remove alpn from TransportServerConfig to decide it dynamically where server is started
This commit is contained in:
Evgeny
2024-09-28 22:21:08 +01:00
committed by GitHub
parent 21eee2b548
commit 3c18c4b66a
22 changed files with 193 additions and 179 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/RemoteControl/Client.hs
+2 -5
View File
@@ -190,7 +190,7 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct
}
pure $ signInvitation (snd sessKeys) idPrivKey inv
genTLSCredentials :: TVar ChaChaDRG -> C.APrivateSignKey -> C.SignedCertificate -> IO TLS.Credentials
genTLSCredentials :: TVar ChaChaDRG -> C.APrivateSignKey -> C.SignedCertificate -> IO TLS.Credential
genTLSCredentials drg caKey caCert = do
let caCreds = (C.signatureKeyPair caKey, caCert)
leaf <- genCredentials drg (Just caCreds) (0, 24 * 999999) "localhost" -- session-signing cert
@@ -282,10 +282,7 @@ connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca,
pure RCCClient_ {confirmSession, endSession}
runClient :: RCCClient_ -> RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> ExceptT RCErrorType IO ()
runClient RCCClient_ {confirmSession, endSession} r = do
clientCredentials <-
liftIO (genTLSCredentials drg caKey caCert) >>= \case
TLS.Credentials (creds : _) -> pure $ Just creds
_ -> throwE $ RCEInternal "genTLSCredentials must generate credentials"
clientCredentials <- liftIO $ Just <$> genTLSCredentials drg caKey caCert
let clientConfig = defaultTransportClientConfig {clientCredentials}
ExceptT . runTransportClient clientConfig Nothing host (show port) (Just ca) $ \tls@TLS {tlsBuffer, tlsContext} -> runExceptT $ do
-- pump socket to detect connection problems
src/Simplex/RemoteControl/Discovery.hs
+5 -5
View File
@@ -23,7 +23,7 @@ import Network.Info (IPv4 (..), NetworkInterface (..), getNetworkInterfaces)
import qualified Network.Socket as N
import qualified Network.TLS as TLS
import qualified Network.UDP as UDP
import Simplex.Messaging.Transport (supportedParameters)
import Simplex.Messaging.Transport (defaultSupportedParams)
import qualified Simplex.Messaging.Transport as Transport
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTransportServerSocket, startTCPServer)
@@ -68,7 +68,7 @@ preferAddress RCCtrlAddress {address, interface} addrs =
matchAddr RCCtrlAddress {address = a} = a == address
matchIface RCCtrlAddress {interface = i} = i == interface
startTLSServer :: Maybe Word16 -> TMVar (Maybe N.PortNumber) -> TLS.Credentials -> TLS.ServerHooks -> (Transport.TLS -> IO ()) -> IO (Async ())
startTLSServer :: Maybe Word16 -> TMVar (Maybe N.PortNumber) -> TLS.Credential -> TLS.ServerHooks -> (Transport.TLS -> IO ()) -> IO (Async ())
startTLSServer port_ startedOnPort credentials hooks server = async . liftIO $ do
started <- newEmptyTMVarIO
bracketOnError (startTCPServer started Nothing $ maybe "0" show port_) (\_e -> setPort Nothing) $ \socket ->
@@ -81,14 +81,14 @@ startTLSServer port_ startedOnPort credentials hooks server = async . liftIO $ d
port <- N.socketPort socket
logInfo $ "System-assigned port: " <> tshow port
setPort $ Just port
runTransportServerSocket started (pure socket) "RCP TLS" serverParams defaultTransportServerConfig server
runTransportServerSocket started (pure socket) "RCP TLS" credentials serverParams defaultTransportServerConfig server
setPort = void . atomically . tryPutTMVar startedOnPort
serverParams =
def
{ TLS.serverWantClientCert = True,
TLS.serverShared = def {TLS.sharedCredentials = credentials},
TLS.serverShared = def {TLS.sharedCredentials = TLS.Credentials [credentials]},
TLS.serverHooks = hooks,
TLS.serverSupported = supportedParameters
TLS.serverSupported = defaultSupportedParams
}
withSender :: (UDP.UDPSocket -> IO a) -> IO a