tls 2.1.0 → 2.1.1

raw patch · 7 files changed

+45/−26 lines, 7 filesdep −unliftio

Dependencies removed: unliftio

Files

• CHANGELOG.md +5/−0
• Network/TLS.hs +8/−0
• Network/TLS/Core.hs +18/−13
• Network/TLS/Crypto.hs +3/−1
• Network/TLS/Handshake/Server/ClientHello.hs +1/−2
• test/Arbitrary.hs +7/−5
• tls.cabal +3/−5

@@ -1,3 +1,8 @@+## Version 2.2.1++* `bye` directly calls `timeout recvHS13`, not spawning a thread for+  `timeout recvHS13`. So, `bye` can receive an exception if thrown.+ ## Version 2.1.0  * Breaking change: stop exporting constructors to maintain future

@@ -10,6 +10,14 @@ -- Currently implement the TLS1.2 and TLS 1.3 -- protocol, and support RSA and Ephemeral (Elliptic curve and -- regular) Diffie Hellman key exchanges, and many extensions.+--+-- The tipical usage is:+--+-- > socket <- ...+-- > ctx <- contextNew socket <params>+-- > handshake ctx+-- > ... (using recvData and sendData)+-- > bye module Network.TLS (     -- * Basic APIs     Context,

@@ -26,7 +26,6 @@     requestCertificate, ) where -import Control.Concurrent import qualified Control.Exception as E import Control.Monad (unless, void, when) import Control.Monad.State.Strict@@ -78,7 +77,7 @@         when (role == ClientRole && tls13 && sentClientCert) $ do             rtt <- getRTT ctx             -- This 'timeout' should work.-            mdat <- timeout rtt $ recvData ctx+            mdat <- timeout rtt $ recvData13 ctx             case mdat of                 Nothing -> return ()                 Just dat -> modifyTLS13State ctx $ \st -> st{tls13stPendingRecvData = Just dat}@@ -92,11 +91,23 @@     let rtt' = max (fromIntegral rtt) 10     return (rtt' * rttFactor * 1000) -- ms to us --- | notify the context that this side wants to close connection.--- this is important that it is called before closing the handle, otherwise+-- | Notify the context that this side wants to close connection.+-- This is important that it is called before closing the handle, otherwise -- the session might not be resumable (for version < TLS1.2).+-- This doesn't actually close the handle. ----- this doesn't actually close the handle+-- Proper usage is as follows:+--+-- > ctx <- contextNew <backend> <params>+-- > handshake ctx+-- > ...+-- > bye+--+-- The following code ensures nothing but is no harm.+--+-- > bracket (contextNew <backend> <params>) bye $ \ctx -> do+-- >   handshake ctx+-- >   ... bye :: MonadIO m => Context -> m () bye ctx = liftIO $ do     eof <- ctxEOF ctx@@ -111,10 +122,7 @@                 recvNST <- chk                 unless recvNST $ do                     rtt <- getRTT ctx-                    var <- newEmptyMVar-                    _ <- forkIOWithUnmask $ \umask ->-                        umask (void $ timeout rtt $ recvHS13 ctx chk) `E.finally` putMVar var ()-                    takeMVar var+                    void $ timeout rtt $ recvHS13 ctx chk             else do                 -- receiving Client Finished                 let chk = tls13stRecvCF <$> getTLS13State ctx@@ -123,10 +131,7 @@                     -- no chance to measure RTT before receiving CF                     -- fixme: 1sec is good enough?                     let rtt = 1000000-                    var <- newEmptyMVar-                    _ <- forkIOWithUnmask $ \umask ->-                        umask (void $ timeout rtt $ recvHS13 ctx chk) `E.finally` putMVar var ()-                    takeMVar var+                    void $ timeout rtt $ recvHS13 ctx chk     bye_ ctx  bye_ :: MonadIO m => Context -> m ()

@@ -115,7 +115,9 @@     pg (DH.Params p g _) = (p, g)      table =-        [ (pg prms, grp) | grp <- availableFFGroups, let prms = fromJust $ dhParamsForGroup grp+        [ (pg prms, grp)+        | grp <- availableFFGroups+        , let prms = fromJust $ dhParamsForGroup grp         ]  findEllipticCurveGroup :: PubKeyEC -> Maybe Group

@@ -28,8 +28,7 @@     eof <- ctxEOF ctx     let renegotiation = established == Established && not eof     when-        ( renegotiation && not (supportedClientInitiatedRenegotiation $ ctxSupported ctx)-        )+        (renegotiation && not (supportedClientInitiatedRenegotiation $ ctxSupported ctx))         $ throwCore         $ Error_Protocol_Warning "renegotiation is not allowed" NoRenegotiation     -- check if policy allow this new handshake to happens

@@ -305,11 +305,13 @@     -- versions for which we have compatible ciphers.  Criteria about cipher     -- ensure we can test version downgrade.     let allowedVersions =-            [ v | v <- knownVersions, or-                                        [ x `elem` serverCiphers-                                            && cipherAllowedForVersion v x-                                        | x <- clientCiphers-                                        ]+            [ v+            | v <- knownVersions+            , or+                [ x `elem` serverCiphers+                    && cipherAllowedForVersion v x+                | x <- clientCiphers+                ]             ]         allowedVersionsFiltered = filter (<= connectVersion) allowedVersions     -- Server or client is allowed to have versions > connectVersion, but not

@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               tls-version:            2.1.0+version:            2.1.1 license:            BSD3 license-file:       LICENSE copyright:          Vincent Hanquez <vincent@snarc.org>@@ -188,8 +188,7 @@         data-default-class,         network,         network-run,-        tls,-        unliftio+        tls      if flag(devel) @@ -217,8 +216,7 @@         data-default-class,         network,         network-run,-        tls,-        unliftio+        tls      if flag(devel)