diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +## 0.1.5 + +- Catching up "tls" v1.9.0. +- Fixing the timing to set resumption tokens. + ## 0.1.4 - Fixing the race of socket closure. diff --git a/Network/QUIC/Client/Run.hs b/Network/QUIC/Client/Run.hs --- a/Network/QUIC/Client/Run.hs +++ b/Network/QUIC/Client/Run.hs @@ -66,13 +66,13 @@ } } setIncompatibleVN conn isICVN -- must be before handshaker + setToken conn $ resumptionToken $ ccResumption conf handshaker <- handshakeClient conf' conn myAuthCIDs let client = do if ccUse0RTT conf then wait0RTTReady conn else wait1RTTReady conn - setToken conn $ resumptionToken $ ccResumption conf client0 conn ldcc = connLDCC conn supporters = foldr1 concurrently_ [handshaker diff --git a/Network/QUIC/Handshake.hs b/Network/QUIC/Handshake.hs --- a/Network/QUIC/Handshake.hs +++ b/Network/QUIC/Handshake.hs @@ -86,8 +86,11 @@ convertLevel (CryptApplicationSecret, bs) = return (RTT1Level, bs) internalError :: String -> TLS.TLSError +#if MIN_VERSION_tls(1,9,0) +internalError msg = TLS.Error_Protocol msg TLS.InternalError +#else internalError msg = TLS.Error_Protocol (msg, True, TLS.InternalError) --- unexpectedMessage msg = TLS.Error_Protocol (msg, True, TLS.UnexpectedMessage) +#endif ---------------------------------------------------------------- @@ -316,4 +319,8 @@ #endif getErrorCause e = let msg = "unexpected TLS exception: " ++ show e +#if MIN_VERSION_tls(1,9,0) + in TLS.Error_Protocol msg TLS.InternalError +#else in TLS.Error_Protocol (msg, True, TLS.InternalError) +#endif diff --git a/quic.cabal b/quic.cabal --- a/quic.cabal +++ b/quic.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: quic -version: 0.1.4 +version: 0.1.5 license: BSD3 license-file: LICENSE maintainer: kazu@iij.ad.jp diff --git a/test/HandshakeSpec.hs b/test/HandshakeSpec.hs --- a/test/HandshakeSpec.hs +++ b/test/HandshakeSpec.hs @@ -7,7 +7,6 @@ import Network.TLS (HandshakeMode13(..), Group(..)) import qualified Network.TLS as TLS import Test.Hspec -import UnliftIO.Async import UnliftIO.Concurrent import qualified UnliftIO.Exception as E @@ -89,26 +88,19 @@ testHandshake :: ClientConfig -> ServerConfig -> IO () -> HandshakeMode13 -> IO () testHandshake cc sc waitS mode = do - concurrently_ server client + mvar <- newEmptyMVar + E.bracket (forkIO $ server mvar) killThread $ \_ -> client mvar where - client = do + client mvar = do waitS C.run cc $ \conn -> do waitEstablished conn handshakeMode <$> getConnectionInfo conn `shouldReturn` mode - server = S.run sc $ \conn -> do + takeMVar mvar + server mvar = S.run sc $ \conn -> do waitEstablished conn handshakeMode <$> getConnectionInfo conn `shouldReturn` mode - delayedStop conn - -delayedStop :: Connection -> IO () -delayedStop conn = do - var <- newEmptyMVar - _ <- forkIO $ do - threadDelay 100 - putMVar var () - takeMVar var - stop conn + putMVar mvar () query :: BS.ByteString -> Connection -> IO () query content conn = do @@ -120,14 +112,15 @@ testHandshake2 :: ClientConfig -> ServerConfig -> IO () -> (HandshakeMode13, HandshakeMode13) -> Bool -> IO () testHandshake2 cc1 sc waitS (mode1, mode2) use0RTT = do - concurrently_ server client + mvar <- newEmptyMVar + E.bracket (forkIO $ server mvar) killThread $ \_ -> client mvar where runClient cc mode action = C.run cc $ \conn -> do void $ action conn handshakeMode <$> getConnectionInfo conn `shouldReturn` mode threadDelay 50000 getResumptionInfo conn - client = do + client mvar = do waitS res <- runClient cc1 mode1 $ query "first" threadDelay 50000 @@ -135,27 +128,29 @@ , ccUse0RTT = use0RTT } void $ runClient cc2 mode2 $ query "second" - server = S.run sc serv + takeMVar mvar + server mvar = S.run sc serv where serv conn = do s <- acceptStream conn bs <- recvStream s 1024 sendStream s "bye" closeStream s - when (bs == "second") $ do - delayedStop conn + when (bs == "second") $ putMVar mvar () testHandshake3 :: ClientConfig -> ClientConfig -> ServerConfig -> IO () -> (QUICException -> Bool) -> IO () testHandshake3 cc1 cc2 sc waitS selector = do - concurrently_ server client + mvar <- newEmptyMVar + E.bracket (forkIO $ server mvar) killThread $ \_ -> client mvar where - client = do + client mvar = do waitS C.run cc1 (query "first") `shouldThrow` selector C.run cc2 (query "second") `shouldReturn` () - server = S.run sc $ \conn -> do + takeMVar mvar + server mvar = S.run sc $ \conn -> do s <- acceptStream conn recvStream s 1024 `shouldReturn` "second" sendStream s "bye" closeStream s - delayedStop conn + putMVar mvar () diff --git a/test/IOSpec.hs b/test/IOSpec.hs --- a/test/IOSpec.hs +++ b/test/IOSpec.hs @@ -5,8 +5,8 @@ import Control.Monad import qualified Data.ByteString as BS import Test.Hspec -import UnliftIO.Async import UnliftIO.Concurrent +import qualified UnliftIO.Exception as E import Network.QUIC import qualified Network.QUIC.Client as C @@ -97,7 +97,7 @@ testRecvStreamClientStopFirst :: C.ClientConfig -> ServerConfig -> IO () -> IO () testRecvStreamClientStopFirst cc sc waitS = do mvar <- newEmptyMVar - void $ concurrently (client mvar) (server mvar) + E.bracket (forkIO $ server mvar) killThread $ \_ -> client mvar where aerr = ApplicationProtocolError 0 @@ -118,12 +118,11 @@ -- verify that client has stopped sending. assertEndOfStream strm putMVar mvar () - stop conn testRecvStreamServerStopFirst :: C.ClientConfig -> ServerConfig -> IO () -> IO () testRecvStreamServerStopFirst cc sc waitS = do mvar <- newEmptyMVar - void $ concurrently (client mvar) (server mvar) + E.bracket (forkIO $ server mvar) killThread $ \_ -> client mvar where aerr = ApplicationProtocolError 0 @@ -142,12 +141,11 @@ assertEndOfStream strm resetStream strm aerr putMVar mvar () - stop conn testSendRecv :: C.ClientConfig -> ServerConfig -> IO () -> Int -> IO () testSendRecv cc sc waitS times = do mvar <- newEmptyMVar - void $ concurrently (client mvar) (server mvar) + E.bracket (forkIO $ server mvar) killThread $ \_ -> client mvar where client mvar = do waitS @@ -162,4 +160,3 @@ consumeBytes strm (10000 * times) assertEndOfStream strm putMVar mvar () - stop conn