deps: use tls-2.0

This commit is contained in:
Alexander Bondarenko
2024-06-11 22:48:06 +03:00
parent bb1d31e459
commit 63789d0c6e
6 changed files with 22 additions and 19 deletions
+1 -1
View File
@@ -4,7 +4,7 @@ packages: .
-- packages: . ../http2
-- packages: . ../network-transport
index-state: 2023-12-12T00:00:00Z
index-state: 2024-06-01T00:00:00Z
package cryptostore
flags: +use_crypton
+1 -1
View File
@@ -69,7 +69,7 @@ dependencies:
- temporary == 1.3.*
- time == 1.12.*
- time-manager == 0.0.*
- tls >= 1.7.0 && < 1.8
- tls >= 2.0.6 && < 2.1
- transformers == 0.6.*
- unliftio == 0.2.*
- unliftio-core == 0.2.*
+6 -6
View File
@@ -255,7 +255,7 @@ library
, temporary ==1.3.*
, time ==1.12.*
, time-manager ==0.0.*
, tls >=1.7.0 && <1.8
, tls >=2.0.6 && <2.1
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
@@ -330,7 +330,7 @@ executable ntf-server
, temporary ==1.3.*
, time ==1.12.*
, time-manager ==0.0.*
, tls >=1.7.0 && <1.8
, tls >=2.0.6 && <2.1
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
@@ -409,7 +409,7 @@ executable smp-server
, temporary ==1.3.*
, time ==1.12.*
, time-manager ==0.0.*
, tls >=1.7.0 && <1.8
, tls >=2.0.6 && <2.1
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
@@ -487,7 +487,7 @@ executable xftp
, temporary ==1.3.*
, time ==1.12.*
, time-manager ==0.0.*
, tls >=1.7.0 && <1.8
, tls >=2.0.6 && <2.1
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
@@ -562,7 +562,7 @@ executable xftp-server
, temporary ==1.3.*
, time ==1.12.*
, time-manager ==0.0.*
, tls >=1.7.0 && <1.8
, tls >=2.0.6 && <2.1
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
@@ -678,7 +678,7 @@ test-suite simplexmq-test
, time ==1.12.*
, time-manager ==0.0.*
, timeit ==2.0.*
, tls >=1.7.0 && <1.8
, tls >=2.0.6 && <2.1
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
+5 -3
View File
@@ -112,6 +112,7 @@ import Simplex.Messaging.Transport.Buffer
import Simplex.Messaging.Util (bshow, catchAll, catchAll_, liftEitherWith)
import Simplex.Messaging.Version
import Simplex.Messaging.Version.Internal
import System.IO.Error (isEOFError)
import UnliftIO.Exception (Exception)
import qualified UnliftIO.Exception as E
import UnliftIO.STM
@@ -335,11 +336,12 @@ instance Transport TLS where
getLn :: TLS -> IO ByteString
getLn TLS {tlsContext, tlsBuffer} = do
getLnBuffered tlsBuffer (T.recvData tlsContext) `E.catch` handleEOF
getLnBuffered tlsBuffer (T.recvData tlsContext) `E.catches` [E.Handler handleTlsEOF, E.Handler handleEOF]
where
handleEOF = \case
T.Error_EOF -> E.throwIO TEBadBlock
handleTlsEOF = \case
T.PostHandshake T.Error_EOF -> E.throwIO TEBadBlock
e -> E.throwIO e
handleEOF e = if isEOFError e then E.throwIO TEBadBlock else E.throwIO e
-- * SMP transport
@@ -25,6 +25,7 @@ import Simplex.Messaging.Transport
withTlsUnique,
)
import Simplex.Messaging.Transport.Buffer (trimCR)
import System.IO.Error (isEOFError)
data WS = WS
{ wsPeer :: TransportPeer,
@@ -108,9 +109,11 @@ makeTLSContextStream cxt =
S.makeStream readStream writeStream
where
readStream :: IO (Maybe ByteString)
readStream =
(Just <$> T.recvData cxt) `E.catch` \case
T.Error_EOF -> pure Nothing
e -> E.throwIO e
readStream = (Just <$> T.recvData cxt) `E.catches` [E.Handler handleTlsEOF, E.Handler handleEOF]
where
handleTlsEOF = \case
T.PostHandshake T.Error_EOF -> pure Nothing
e -> E.throwIO e
handleEOF e = if isEOFError e then pure Nothing else E.throwIO e
writeStream :: Maybe LB.ByteString -> IO ()
writeStream = maybe (closeTLS cxt) (T.sendData cxt)
+2 -4
View File
@@ -281,9 +281,7 @@ connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca,
TLS.Credentials (creds : _) -> pure $ Just creds
_ -> throwE $ RCEInternal "genTLSCredentials must generate credentials"
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
liftIO $ peekBuffered tlsBuffer 100000 (TLS.recvData tlsContext) >>= logDebug . tshow -- should normally be ("", Nothing) here
ExceptT . runTransportClient clientConfig Nothing host (show port) (Just ca) $ \tls -> runExceptT $ do
logDebug "Got TLS connection"
r' <- newEmptyTMVarIO
whenM (atomically $ tryPutTMVar r $ Right (tlsUniq tls, tls, r')) $ do
@@ -305,7 +303,7 @@ connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca,
catchRCError :: ExceptT RCErrorType IO a -> (RCErrorType -> ExceptT RCErrorType IO a) -> ExceptT RCErrorType IO a
catchRCError = catchAllErrors $ \e -> case fromException e of
Just (TLS.Terminated _ _ (TLS.Error_Protocol (_, _, TLS.UnknownCa))) -> RCEIdentity
Just (TLS.Terminated _ _ (TLS.Error_Protocol _ TLS.UnknownCa)) -> RCEIdentity
_ -> RCEException $ show e
{-# INLINE catchRCError #-}