quic 0.2.4 → 0.2.5

raw patch · 8 files changed

+28/−58 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Network/QUIC/Client/Reader.hs +1/−1
• Network/QUIC/Connection/Misc.hs +1/−1
• Network/QUIC/Connection/Timeout.hs +5/−53
• Network/QUIC/Exception.hs +2/−0
• Network/QUIC/Utils.hs +14/−1
• Network/QUIC/Windows.hs +0/−1
• quic.cabal +1/−1

@@ -1,5 +1,9 @@ # ChangeLog +## 0.2.5++* Re-throwing asynchronous exceptions.+ ## 0.2.4  * Putting `#if` for `threadLabel`.

@@ -34,7 +34,7 @@     loop   where     wait = do-        bound <- E.handle (\(E.SomeException _) -> return False) $ do+        bound <- E.handle (throughAsync (return False)) $ do             _ <- getSocketName s0             return True         unless bound $ do

@@ -150,7 +150,7 @@ addResource :: Connection -> IO () -> IO () addResource Connection{..} f = atomicModifyIORef'' connResources $ \fs -> f' >> fs   where-    f' = f `E.catch` (\(E.SomeException _) -> return ())+    f' = f `E.catch` ignore  freeResources :: Connection -> IO () freeResources Connection{..} =

@@ -6,65 +6,17 @@ ) where  import Control.Concurrent-import Control.Exception-import Data.Unique (Unique, newUnique)-import GHC.Conc.Sync+import qualified Control.Exception as E import Network.QUIC.Event+import qualified System.Timeout as ST  import Network.QUIC.Connection.Types import Network.QUIC.Connector import Network.QUIC.Imports import Network.QUIC.Types -newtype Timeout = Timeout Unique deriving (Eq)--instance Show Timeout where-    show _ = "<<timeout>>"--instance Exception Timeout where-    toException = asyncExceptionToException-    fromException = asyncExceptionFromException---- 'SomeException') within the computation will break the timeout behavior. timeout :: Microseconds -> String -> IO a -> IO (Maybe a)-timeout (Microseconds n) label f-    | n < 0 = fmap Just f-    | n == 0 = return Nothing-    | otherwise = do-        -- In the threaded RTS, we use the Timer Manager to delay the-        -- (fairly expensive) 'forkIO' call until the timeout has expired.-        ---        -- An additional thread is required for the actual delivery of-        -- the Timeout exception because killThread (or another throwTo)-        -- is the only way to reliably interrupt a throwTo in flight.-        pid <- myThreadId-        ex <- fmap Timeout newUnique-        tm <- getSystemTimerManager-        -- 'lock' synchronizes the timeout handler and the main thread:-        --  * the main thread can disable the handler by writing to 'lock';-        --  * the handler communicates the spawned thread's id through 'lock'.-        -- These two cases are mutually exclusive.-        lock <- newEmptyMVar-        let handleTimeout = do-                v <- isEmptyMVar lock-                when v $ void $ forkIOWithUnmask $ \unmask -> unmask $ do-                    tid <- myThreadId-                    labelThread tid $ "timeout:" ++ label-                    v2 <- tryPutMVar lock =<< myThreadId-                    when v2 $ throwTo pid ex-            cleanupTimeout key = uninterruptibleMask_ $ do-                v <- tryPutMVar lock undefined-                if v-                    then unregisterTimeout tm key-                    else takeMVar lock >>= killThread-        handleJust-            (\e -> if e == ex then Just () else Nothing)-            (\_ -> return Nothing)-            ( bracket-                (registerTimeout tm n handleTimeout)-                cleanupTimeout-                (\_ -> fmap Just f)-            )+timeout (Microseconds ms) _ action = ST.timeout ms action  fire :: Connection -> Microseconds -> TimeoutCallback -> IO () fire conn (Microseconds microseconds) action = do@@ -73,7 +25,7 @@   where     action' = do         alive <- getAlive conn-        when alive action `catch` ignore+        when alive action `E.catch` ignore  cfire :: Connection -> Microseconds -> TimeoutCallback -> IO (IO ()) cfire conn (Microseconds microseconds) action = do@@ -84,7 +36,7 @@   where     action' = do         alive <- getAlive conn-        when alive action `catch` ignore+        when alive action `E.catch` ignore  delay :: Microseconds -> IO () delay (Microseconds microseconds) = threadDelay microseconds

@@ -9,6 +9,7 @@ import qualified GHC.IO.Exception as E import qualified System.IO.Error as E +import Network.QUIC.Imports import Network.QUIC.Logger  -- Catch all exceptions including asynchronous ones.@@ -16,6 +17,7 @@ handleLogUnit logAction action = action `E.catch` handler   where     handler :: E.SomeException -> IO ()+    handler se | isAsyncException se = E.throwIO se     handler se = case E.fromException se of         -- threadWait: invalid argument (Bad file descriptor)         Just e | E.ioeGetErrorType e == E.InvalidArgument -> return ()

@@ -58,4 +58,17 @@ shortpack = Short.toShort . C8.pack  ignore :: SomeException -> IO ()-ignore _ = return ()+ignore se+    | isAsyncException se = throwIO se+    | otherwise = return ()++isAsyncException :: Exception e => e -> Bool+isAsyncException e =+    case fromException (toException e) of+        Just (SomeAsyncException _) -> True+        Nothing -> False++throughAsync :: IO a -> SomeException -> IO a+throughAsync action (SomeException e)+    | isAsyncException e = throwIO e+    | otherwise = action

@@ -12,7 +12,6 @@ windowsThreadBlockHack :: IO a -> IO a windowsThreadBlockHack act = do     var <- newEmptyMVar :: IO (MVar (Either CE.SomeException a))-    -- Catch and rethrow even async exceptions, so don't bother with UnliftIO     void . forkIO $ CE.try act >>= putMVar var     res <- takeMVar var     case res of

@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               quic-version:            0.2.4+version:            0.2.5 license:            BSD3 license-file:       LICENSE maintainer:         kazu@iij.ad.jp