quic 0.1.5 → 0.1.6
raw patch · 14 files changed
+37/−53 lines, 14 files
Files
- ChangeLog.md +4/−0
- Network/QUIC/Client/Reader.hs +3/−3
- Network/QUIC/Client/Run.hs +1/−3
- Network/QUIC/Closer.hs +2/−4
- Network/QUIC/Connection/Misc.hs +0/−12
- Network/QUIC/Connection/Timeout.hs +12/−18
- Network/QUIC/Connection/Types.hs +0/−2
- Network/QUIC/Receiver.hs +3/−2
- Network/QUIC/Sender.hs +2/−1
- Network/QUIC/Server/Reader.hs +3/−3
- Network/QUIC/Server/Run.hs +1/−2
- Network/QUIC/Stream/Misc.hs +2/−0
- quic.cabal +1/−1
- test/IOSpec.hs +3/−2
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.1.6++- Fixing the race condition of `timeout`.+ ## 0.1.5 - Catching up "tls" v1.9.0.
Network/QUIC/Client/Reader.hs view
@@ -44,7 +44,7 @@ wait loop = do ito <- readMinIdleTimeout conn- mbs <- timeout ito $+ mbs <- timeout ito "readeClient" $ #if defined(mingw32_HOST_OS) windowsThreadBlockHack $ #endif@@ -118,7 +118,7 @@ controlConnection' :: Connection -> ConnectionControl -> IO Bool controlConnection' conn ChangeServerCID = do- mn <- timeout (Microseconds 1000000) $ waitPeerCID conn -- fixme+ mn <- timeout (Microseconds 1000000) "controlConnection' 1" $ waitPeerCID conn -- fixme case mn of Nothing -> return False Just (CIDInfo n _ _) -> do@@ -133,7 +133,7 @@ rebind conn $ Microseconds 5000 -- nearly 0 return True controlConnection' conn ActiveMigration = do- mn <- timeout (Microseconds 1000000) $ waitPeerCID conn -- fixme+ mn <- timeout (Microseconds 1000000) "controlConnection' 2" $ waitPeerCID conn -- fixme case mn of Nothing -> return False mcidinfo -> do
Network/QUIC/Client/Run.hs view
@@ -58,8 +58,7 @@ runClient :: ClientConfig -> (Connection -> IO a) -> Bool -> VersionInfo -> IO a runClient conf client0 isICVN verInfo = do E.bracket open clse $ \(ConnRes conn myAuthCIDs reader) -> do- forkIO reader >>= addReader conn- forkIO timeouter >>= addTimeouter conn+ forkIO reader >>= addReader conn let conf' = conf { ccParameters = (ccParameters conf) { versionInformation = Just verInfo@@ -96,7 +95,6 @@ setDead conn freeResources conn killReaders conn- join $ replaceKillTimeouter conn createClientConnection :: ClientConfig -> VersionInfo -> IO ConnRes createClientConnection conf@ClientConfig{..} verInfo = do
Network/QUIC/Closer.hs view
@@ -40,7 +40,6 @@ closure' :: Connection -> LDCC -> Frame -> IO () closure' conn ldcc frame = do killReaders conn- killTimeouter <- replaceKillTimeouter conn let bufsiz = maximumUdpPayloadSize sendBuf <- mallocBytes bufsiz recvBuf <- mallocBytes bufsiz@@ -62,7 +61,6 @@ free sendBuf free recvBuf clos- killTimeouter encodeCC :: Connection -> SizedBuffer -> Frame -> IO Int encodeCC conn res0@(SizedBuffer sendBuf0 bufsiz0) frame = do@@ -103,13 +101,13 @@ loop n = do send getTimeMicrosecond >>= skip (Microseconds pto)- mx <- timeout (Microseconds (pto !>>. 1)) recv+ mx <- timeout (Microseconds (pto !>>. 1)) "closer 1" recv case mx of Nothing -> hook Just 0 -> return () Just _ -> loop (n - 1) skip tmo@(Microseconds duration) base = do- mx <- timeout tmo recv+ mx <- timeout tmo "closer 2" recv case mx of Nothing -> return () Just 0 -> return ()
Network/QUIC/Connection/Misc.hs view
@@ -21,8 +21,6 @@ , setMaxPacketSize , addReader , killReaders- , addTimeouter- , replaceKillTimeouter , addResource , freeResources , readMinIdleTimeout@@ -159,16 +157,6 @@ killReaders :: Connection -> IO () killReaders Connection{..} = join $ readIORef readers--------------------------------------------------------------------addTimeouter :: Connection -> ThreadId -> IO ()-addTimeouter Connection{..} tid = do- wtid <- mkWeakThreadId tid- writeIORef tmouter (deRefWeak wtid >>= mapM_ killThread)--replaceKillTimeouter :: Connection -> IO (IO ())-replaceKillTimeouter Connection{..} = atomicModifyIORef' tmouter (return (),) ----------------------------------------------------------------
Network/QUIC/Connection/Timeout.hs view
@@ -1,8 +1,8 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} module Network.QUIC.Connection.Timeout (- timeouter- , timeout+ timeout , fire , cfire , delay@@ -10,38 +10,32 @@ import Data.Typeable import Network.QUIC.Event-import System.IO.Unsafe (unsafePerformIO) import UnliftIO.Concurrent import qualified UnliftIO.Exception as E-import UnliftIO.STM import Network.QUIC.Connection.Types import Network.QUIC.Connector import Network.QUIC.Imports import Network.QUIC.Types -data TimeoutException = TimeoutException deriving (Show, Typeable)+data TimeoutException = TimeoutException String deriving (Show, Typeable) instance E.Exception TimeoutException where fromException = E.asyncExceptionFromException toException = E.asyncExceptionToException -globalTimeoutQ :: TQueue (IO ())-globalTimeoutQ = unsafePerformIO newTQueueIO-{-# NOINLINE globalTimeoutQ #-}--timeouter :: IO ()-timeouter = forever $ join $ atomically (readTQueue globalTimeoutQ)--timeout :: Microseconds -> IO a -> IO (Maybe a)-timeout (Microseconds ms) action = do+timeout :: Microseconds -> String -> IO a -> IO (Maybe a)+timeout (Microseconds ms) dmsg action = do tid <- myThreadId timmgr <- getSystemTimerManager- let killMe = E.throwTo tid TimeoutException- onTimeout = atomically $ writeTQueue globalTimeoutQ killMe- setup = registerTimeout timmgr ms onTimeout+#if defined(mingw32_HOST_OS)+ let killMe = void $ forkIO $ E.throwTo tid $ TimeoutException dmsg+#else+ let killMe = E.throwTo tid $ TimeoutException dmsg+#endif+ setup = registerTimeout timmgr ms killMe cleanup key = unregisterTimeout timmgr key- E.handleSyncOrAsync (\TimeoutException -> return Nothing) $+ E.handleSyncOrAsync (\(TimeoutException _) -> return Nothing) $ E.bracket setup cleanup $ \_ -> Just <$> action fire :: Connection -> Microseconds -> TimeoutCallback -> IO ()
Network/QUIC/Connection/Types.hs view
@@ -184,7 +184,6 @@ , connRecvQ :: RecvQ , udpSocket :: ~(IORef UDPSocket) , readers :: IORef (IO ())- , tmouter :: IORef (IO ()) , mainThreadId :: ThreadId -- Info , roleInfo :: IORef RoleInfo@@ -278,7 +277,6 @@ dcrptBuf <- mallocBytes bufsiz Connection connstate debugLog qLog hooks send recv recvQ sref <$> newIORef (return ())- <*> newIORef (return ()) <*> myThreadId -- Info <*> newIORef initialRoleInfo
Network/QUIC/Receiver.hs view
@@ -35,7 +35,7 @@ -- The spec says that CC is not sent when timeout. -- But we intentionally sends CC when timeout. ito <- readMinIdleTimeout conn- mx <- timeout ito $ connRecv conn -- fixme: taking minimum with peer's one+ mx <- timeout ito "recvTimeout" $ connRecv conn -- fixme: taking minimum with peer's one case mx of Nothing -> do st <- getConnectionState conn@@ -77,7 +77,8 @@ processReceivedPacketHandshake conn rpkt = do let CryptPacket hdr _ = rpCryptPacket rpkt lvl = rpEncryptionLevel rpkt- mx <- timeout (Microseconds 10000) $ waitEncryptionLevel conn lvl+ msg = "processReceivedPacketHandshake " ++ if isServer conn then "Server" else "Client"+ mx <- timeout (Microseconds 10000) msg $ waitEncryptionLevel conn lvl case mx of Nothing -> do putOffCrypto conn lvl rpkt
Network/QUIC/Sender.hs view
@@ -224,10 +224,11 @@ sendFinal :: Connection -> IO () sendFinal conn = loop 30 where+ msg = "sendFinal " ++ if isServer conn then "Server" else "Client" loop :: Int -> IO () loop 0 = return () loop n = do- mx <- timeout (Microseconds 10) $ sendP conn+ mx <- timeout (Microseconds 10) msg $ sendP conn case mx of Nothing -> return () Just () -> loop (n - 1)
Network/QUIC/Server/Reader.hs view
@@ -314,7 +314,7 @@ sendRetry = do newdCID <- newCID retryToken <- generateRetryToken peerVer newdCID sCID dCID- mnewtoken <- timeout (Microseconds 100000) $ encryptToken tokenMgr retryToken+ mnewtoken <- timeout (Microseconds 100000) "sendRetry" $ encryptToken tokenMgr retryToken case mnewtoken of Nothing -> logAction "retry token stacked" Just newtoken -> do@@ -367,7 +367,7 @@ where loop = do ito <- readMinIdleTimeout conn- mbs <- timeout ito $ UDP.recv us+ mbs <- timeout ito "readerServer" $ UDP.recv us case mbs of Nothing -> UDP.close us Just bs -> do@@ -388,7 +388,7 @@ unless migrating $ do setMigrationStarted conn -- fixme: should not block- mcidinfo <- timeout (Microseconds 100000) $ waitPeerCID conn+ mcidinfo <- timeout (Microseconds 100000) "runNewServerReader" $ waitPeerCID conn let msg = "Migration: " <> bhow peersa <> " (" <> bhow dCID <> ")" qlogDebug conn $ Debug $ toLogStr msg connDebugLog conn $ "debug: runNewServerReader: " <> msg
Network/QUIC/Server/Run.hs view
@@ -57,8 +57,7 @@ -- fixme: the case where sockets cannot be created. ssas <- mapM UDP.serverSocket $ scAddresses conf tids <- mapM (runDispatcher dispatch conf) ssas- ttid <- forkIO timeouter -- fixme- return (dispatch, ttid:tids)+ return (dispatch, tids) teardown (dispatch, tids) = do clearDispatch dispatch mapM_ killThread tids
Network/QUIC/Stream/Misc.hs view
@@ -58,6 +58,8 @@ setRxStreamClosed :: Stream -> IO () setRxStreamClosed strm@Stream{..} = do atomicModifyIORef'' streamStateRx set+ -- Sending a pseudo FIN so that recvStream doesn't block.+ -- See https://github.com/kazu-yamamoto/quic/pull/54 putRecvStreamQ strm "" where set (StreamState off _) = StreamState off True
quic.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: quic-version: 0.1.5+version: 0.1.6 license: BSD3 license-file: LICENSE maintainer: kazu@iij.ad.jp
test/IOSpec.hs view
@@ -77,6 +77,7 @@ it "can exchange data on client 11" $ do withPipe (DropClientPacket [11]) $ testSendRecv cc sc waitS 20 describe "recvStream" $ do+ -- https://github.com/kazu-yamamoto/quic/pull/54 it "don't block if client stop sending first" $ do withPipe (Randomly 20) $ testRecvStreamClientStopFirst cc sc waitS it "don't block if server stop sending first" $ do@@ -115,7 +116,7 @@ consumeBytes strm 10000 `shouldReturn` () -- notify client to stop stream after all bytes are received. putMVar mvar ()- -- verify that client has stopped sending.+ -- verify that recvStream does not block assertEndOfStream strm putMVar mvar () @@ -137,7 +138,7 @@ consumeBytes strm 10000 `shouldReturn` () -- ask client to stop sending. stopStream strm aerr- -- verify that client has stopped sending.+ -- verify that recvStream does not block assertEndOfStream strm resetStream strm aerr putMVar mvar ()