quic 0.2.2 → 0.2.3
raw patch · 49 files changed
+205/−125 lines, 49 filesdep +data-defaultdep −data-default-classdep −unliftiodep −unliftio-coredep ~containersdep ~crypto-tokendep ~filepath
Dependencies added: data-default
Dependencies removed: data-default-class, unliftio, unliftio-core
Dependency ranges changed: containers, crypto-token, filepath, tls
Files
- ChangeLog.md +6/−0
- Network/QUIC/Client/Reader.hs +3/−3
- Network/QUIC/Client/Run.hs +4/−4
- Network/QUIC/Closer.hs +6/−3
- Network/QUIC/Common.hs +11/−0
- Network/QUIC/Config.hs +8/−2
- Network/QUIC/Connection/Crypto.hs +2/−2
- Network/QUIC/Connection/Migration.hs +3/−3
- Network/QUIC/Connection/Misc.hs +2/−2
- Network/QUIC/Connection/Queue.hs +1/−1
- Network/QUIC/Connection/Role.hs +1/−1
- Network/QUIC/Connection/State.hs +5/−5
- Network/QUIC/Connection/Stream.hs +7/−7
- Network/QUIC/Connection/Timeout.hs +54/−6
- Network/QUIC/Connection/Types.hs +2/−2
- Network/QUIC/Connector.hs +1/−1
- Network/QUIC/Crypto/Keys.hs +2/−2
- Network/QUIC/Exception.hs +3/−3
- Network/QUIC/Handshake.hs +1/−1
- Network/QUIC/IO.hs +3/−3
- Network/QUIC/Packet/Decode.hs +1/−1
- Network/QUIC/Receiver.hs +1/−1
- Network/QUIC/Recovery/Interface.hs +4/−4
- Network/QUIC/Recovery/LossRecovery.hs +1/−1
- Network/QUIC/Recovery/Metrics.hs +1/−1
- Network/QUIC/Recovery/Release.hs +1/−1
- Network/QUIC/Recovery/Timer.hs +2/−2
- Network/QUIC/Recovery/Types.hs +1/−1
- Network/QUIC/Recovery/Utils.hs +2/−2
- Network/QUIC/Sender.hs +3/−3
- Network/QUIC/Server/Reader.hs +11/−5
- Network/QUIC/Server/Run.hs +19/−15
- Network/QUIC/Socket.hs +1/−1
- Network/QUIC/Stream/Misc.hs +1/−1
- Network/QUIC/Stream/Queue.hs +1/−1
- Network/QUIC/Stream/Types.hs +2/−2
- Network/QUIC/TLS.hs +2/−2
- Network/QUIC/Types/Exception.hs +1/−1
- Network/QUIC/Types/Queue.hs +1/−1
- Network/QUIC/Utils.hs +1/−1
- quic.cabal +10/−14
- test/Config.hs +2/−2
- test/ErrorSpec.hs +1/−1
- test/FrameSpec.hs +1/−1
- test/HandshakeSpec.hs +2/−2
- test/IOSpec.hs +3/−3
- test/TransportError.hs +2/−2
- util/ServerX.hs +1/−1
- util/quic-client.hs +1/−1
ChangeLog.md view
@@ -1,5 +1,11 @@ # ChangeLog +## 0.2.3++* Supporting tls v2.1.3.+* Labeling threads.+* Using data-default.+ ## 0.2.2 # Introducing streamNotCreatedYet for STOP_SENDING.
Network/QUIC/Client/Reader.hs view
@@ -9,11 +9,11 @@ clientSocket, ) where +import Control.Concurrent+import qualified Control.Exception as E import Data.List (intersect) import Network.Socket (Socket, close, getSocketName) import qualified Network.Socket.ByteString as NSB-import UnliftIO.Concurrent-import qualified UnliftIO.Exception as E import Network.QUIC.Connection import Network.QUIC.Connector@@ -34,7 +34,7 @@ loop where wait = do- bound <- E.handleAny (\_ -> return False) $ do+ bound <- E.handle (\(E.SomeException _) -> return False) $ do _ <- getSocketName s0 return True unless bound $ do
Network/QUIC/Client/Run.hs view
@@ -7,10 +7,10 @@ migrate, ) where +import Control.Concurrent+import Control.Concurrent.Async+import qualified Control.Exception as E import qualified Network.Socket as NS-import UnliftIO.Async-import UnliftIO.Concurrent-import qualified UnliftIO.Exception as E import Network.QUIC.Client.Reader import Network.QUIC.Closer@@ -92,7 +92,7 @@ case er of Left () -> E.throwIO MustNotReached Right r -> return r- ex <- E.trySyncOrAsync runThreads+ ex <- E.try runThreads sendFinal conn closure conn ldcc ex where
Network/QUIC/Closer.hs view
@@ -2,12 +2,13 @@ module Network.QUIC.Closer (closure) where +import Control.Concurrent+import qualified Control.Exception as E import Foreign.Marshal.Alloc import Foreign.Ptr import qualified Network.Socket as NS-import UnliftIO.Concurrent-import qualified UnliftIO.Exception as E +import Network.QUIC.Common import Network.QUIC.Config import Network.QUIC.Connection import Network.QUIC.Connector@@ -101,7 +102,9 @@ return 0 closer :: Connection -> Microseconds -> IO () -> IO () -> IO () -> IO ()-closer _conn (Microseconds pto) send recv hook = loop (3 :: Int)+closer _conn (Microseconds pto) send recv hook = do+ labelMe "QUIC closer"+ loop (3 :: Int) where loop 0 = return () loop n = do
Network/QUIC/Common.hs view
@@ -4,6 +4,9 @@ import qualified Network.Socket as NS +import Control.Concurrent+import GHC.Conc.Sync+ import Network.QUIC.Connection import Network.QUIC.Parameters import Network.QUIC.Types@@ -22,3 +25,11 @@ maximumPacketSize :: NS.SockAddr -> Int maximumPacketSize NS.SockAddrInet6{} = 1500 - 40 - 8 -- fixme maximumPacketSize _ = 1500 - 20 - 8 -- fixme++labelMe :: String -> IO ()+labelMe name = do+ tid <- myThreadId+ mlabel <- threadLabel tid+ case mlabel of+ Nothing -> labelThread tid name+ Just _ -> return ()
Network/QUIC/Config.hs view
@@ -3,10 +3,16 @@ module Network.QUIC.Config where -import Data.Default.Class+import Data.Default import Data.IP import Network.Socket-import Network.TLS hiding (Hooks, HostName, Version)+import Network.TLS hiding (+ Hooks,+ HostName,+ Version,+ defaultHooks,+ defaultSupported,+ ) import Network.TLS.QUIC import Network.QUIC.Imports
Network/QUIC/Connection/Crypto.hs view
@@ -24,8 +24,8 @@ setCurrentKeyPhase, ) where +import Control.Concurrent.STM import Network.TLS.QUIC-import UnliftIO.STM import Network.QUIC.Connection.Misc import Network.QUIC.Connection.Types@@ -63,7 +63,7 @@ waitEncryptionLevel :: Connection -> EncryptionLevel -> IO () waitEncryptionLevel Connection{..} lvl = atomically $ do l <- readTVar $ encryptionLevel connState- checkSTM (l >= lvl)+ check (l >= lvl) ----------------------------------------------------------------
Network/QUIC/Connection/Migration.hs view
@@ -26,9 +26,9 @@ validatePath, ) where +import Control.Concurrent.STM import qualified Data.IntMap.Strict as IntMap import qualified Data.Map.Strict as Map-import UnliftIO.STM import Network.QUIC.Connection.Misc import Network.QUIC.Connection.Queue@@ -123,7 +123,7 @@ let ref = peerCIDDB db <- readTVar ref mncid <- pickPeerCID conn- checkSTM $ isJust mncid+ check $ isJust mncid let u = usedCIDInfo db setPeerCID conn (fromJust mncid) True return u@@ -313,7 +313,7 @@ waitResponse :: Connection -> IO () waitResponse Connection{..} = atomically $ do state <- readTVar migrationState- checkSTM (state == RecvResponse)+ check (state == RecvResponse) writeTVar migrationState NonMigration checkResponse :: Connection -> PathData -> IO ()
Network/QUIC/Connection/Misc.hs view
@@ -33,10 +33,10 @@ abortConnection, ) where +import Control.Concurrent+import qualified Control.Exception as E import Network.Socket (Socket) import System.Mem.Weak-import UnliftIO.Concurrent-import qualified UnliftIO.Exception as E import Network.QUIC.Connection.Queue import Network.QUIC.Connection.Timeout
Network/QUIC/Connection/Queue.hs view
@@ -1,6 +1,6 @@ module Network.QUIC.Connection.Queue where -import UnliftIO.STM+import Control.Concurrent.STM import Network.QUIC.Connection.Types import Network.QUIC.Imports
Network/QUIC/Connection/Role.hs view
@@ -22,9 +22,9 @@ getCertificateChain, ) where +import Control.Concurrent import qualified Crypto.Token as CT import Data.X509 (CertificateChain)-import UnliftIO.Concurrent import Network.QUIC.Connection.Misc import Network.QUIC.Connection.Types
Network/QUIC/Connection/State.hs view
@@ -24,8 +24,8 @@ checkAntiAmplificationFree, ) where +import Control.Concurrent.STM import Network.Control-import UnliftIO.STM import Network.QUIC.Connection.Types import Network.QUIC.Connector@@ -62,20 +62,20 @@ wait0RTTReady :: Connection -> IO () wait0RTTReady Connection{..} = atomically $ do cs <- readTVar $ connectionState connState- checkSTM (cs >= ReadyFor0RTT)+ check (cs >= ReadyFor0RTT) -- | Waiting until 1-RTT data can be sent. wait1RTTReady :: Connection -> IO () wait1RTTReady Connection{..} = atomically $ do cs <- readTVar $ connectionState connState- checkSTM (cs >= ReadyFor1RTT)+ check (cs >= ReadyFor1RTT) -- | For clients, waiting until HANDSHAKE_DONE is received. -- For servers, waiting until a TLS stack reports that the handshake is complete. waitEstablished :: Connection -> IO () waitEstablished Connection{..} = atomically $ do cs <- readTVar $ connectionState connState- checkSTM (cs >= Established)+ check (cs >= Established) ---------------------------------------------------------------- @@ -134,7 +134,7 @@ ok <- checkAntiAmplificationFree conn siz unless ok $ do beforeAntiAmp connLDCC- atomically (checkAntiAmplificationFreeSTM conn siz >>= checkSTM)+ atomically (checkAntiAmplificationFreeSTM conn siz >>= check) -- setLossDetectionTimer is called eventually.
Network/QUIC/Connection/Stream.hs view
@@ -14,7 +14,7 @@ checkStreamIdRoom, ) where -import UnliftIO.STM+import Control.Concurrent.STM import Network.QUIC.Connection.Misc import Network.QUIC.Connection.Types@@ -45,7 +45,7 @@ conc@Concurrency{..} <- readTVar tvar let streamType = currentStream .&. 0b11 StreamIdBase base = maxStreams- checkSTM (currentStream < base * 4 + streamType)+ check (currentStream < base * 4 + streamType) let currentStream' = currentStream + 4 writeTVar tvar conc{currentStream = currentStream'} return currentStream@@ -68,15 +68,15 @@ || (isServer conn && isClientInitiatedBidirectional sid) ) $ do- atomicModifyIORef'' (peerStreamId conn) check+ atomicModifyIORef'' (peerStreamId conn) checkConc when ( (isClient conn && isServerInitiatedUnidirectional sid) || (isServer conn && isClientInitiatedUnidirectional sid) ) $ do- atomicModifyIORef'' (peerUniStreamId conn) check+ atomicModifyIORef'' (peerUniStreamId conn) checkConc where- check conc@Concurrency{..}+ checkConc conc@Concurrency{..} | currentStream < sid = conc{currentStream = sid} | otherwise = conc @@ -106,9 +106,9 @@ let ref | dir == Bidirectional = peerStreamId conn | otherwise = peerUniStreamId conn- atomicModifyIORef' ref check+ atomicModifyIORef' ref checkConc where- check conc@Concurrency{..} =+ checkConc conc@Concurrency{..} = let StreamIdBase base = maxStreams initialStreams = initialMaxStreamsBidi $ getMyParameters conn cbase = currentStream !>>. 2
Network/QUIC/Connection/Timeout.hs view
@@ -5,18 +5,66 @@ delay, ) where +import Control.Concurrent+import Control.Exception+import Data.Unique (Unique, newUnique)+import GHC.Conc.Sync import Network.QUIC.Event-import qualified System.Timeout as ST-import UnliftIO.Concurrent-import qualified UnliftIO.Exception as E 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 ms) _ action = ST.timeout ms action+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)+ ) fire :: Connection -> Microseconds -> TimeoutCallback -> IO () fire conn (Microseconds microseconds) action = do@@ -25,7 +73,7 @@ where action' = do alive <- getAlive conn- when alive action `E.catchSyncOrAsync` ignore+ when alive action `catch` ignore cfire :: Connection -> Microseconds -> TimeoutCallback -> IO (IO ()) cfire conn (Microseconds microseconds) action = do@@ -36,7 +84,7 @@ where action' = do alive <- getAlive conn- when alive action `E.catchSyncOrAsync` ignore+ when alive action `catch` ignore delay :: Microseconds -> IO () delay (Microseconds microseconds) = threadDelay microseconds
Network/QUIC/Connection/Types.hs view
@@ -5,6 +5,8 @@ module Network.QUIC.Connection.Types where +import Control.Concurrent+import Control.Concurrent.STM import qualified Crypto.Token as CT import Data.Array.IO import Data.ByteString.Internal@@ -18,8 +20,6 @@ import Network.Control (Rate, RxFlow, TxFlow, newRate, newRxFlow, newTxFlow) import Network.Socket (Cmsg, SockAddr, Socket) import Network.TLS.QUIC-import UnliftIO.Concurrent-import UnliftIO.STM import Network.QUIC.Config import Network.QUIC.Connector
Network/QUIC/Connector.hs view
@@ -1,8 +1,8 @@ module Network.QUIC.Connector where +import Control.Concurrent.STM import Data.IORef import Network.QUIC.Types-import UnliftIO.STM class Connector a where getRole :: a -> Role
Network/QUIC/Crypto/Keys.hs view
@@ -12,10 +12,10 @@ headerProtectionKey, ) where +import qualified Control.Exception as E import Network.TLS hiding (Version) import Network.TLS.Extra.Cipher import Network.TLS.QUIC-import qualified UnliftIO.Exception as E import Network.QUIC.Crypto.Types import Network.QUIC.Imports@@ -35,7 +35,7 @@ "\x38\x76\x2c\xf7\xf5\x59\x34\xb3\x4d\x17\x9a\xe6\xa4\xc8\x0c\xad\xcc\xbb\x7f\x0a" initialSalt Version2 = "\x0d\xed\xe3\xde\xf7\x00\xa6\xdb\x81\x93\x81\xbe\x6e\x26\x9d\xcb\xf9\xbd\x2e\xd9"-initialSalt (Version v) = E.impureThrow $ VersionIsUnknown v+initialSalt (Version v) = E.throw $ VersionIsUnknown v initialSecrets :: Version -> CID -> TrafficSecrets InitialSecret initialSecrets v c = (clientInitialSecret v c, serverInitialSecret v c)
Network/QUIC/Exception.hs view
@@ -5,15 +5,15 @@ handleLogUnit, ) where +import qualified Control.Exception as E import qualified GHC.IO.Exception as E import qualified System.IO.Error as E-import qualified UnliftIO.Exception as E import Network.QUIC.Logger -- Catch all exceptions including asynchronous ones. handleLogUnit :: DebugLogger -> IO () -> IO ()-handleLogUnit logAction action = action `E.catchSyncOrAsync` handler+handleLogUnit logAction action = action `E.catch` handler where handler :: E.SomeException -> IO () handler se = case E.fromException se of@@ -25,7 +25,7 @@ -- Log and throw an exception handleLogT :: DebugLogger -> IO a -> IO a-handleLogT logAction action = action `E.catchAny` handler+handleLogT logAction action = action `E.catch` handler where handler (E.SomeException e) = do logAction $ bhow e
Network/QUIC/Handshake.hs view
@@ -3,10 +3,10 @@ module Network.QUIC.Handshake where +import qualified Control.Exception as E import Data.List (intersect) import qualified Network.TLS as TLS import Network.TLS.QUIC-import qualified UnliftIO.Exception as E import Network.QUIC.Config import Network.QUIC.Connection
Network/QUIC/IO.hs view
@@ -1,9 +1,9 @@ module Network.QUIC.IO where +import Control.Concurrent.STM+import qualified Control.Exception as E import qualified Data.ByteString as BS import Network.Control-import qualified UnliftIO.Exception as E-import UnliftIO.STM import Network.QUIC.Connection import Network.QUIC.Connector@@ -110,7 +110,7 @@ connWindow = txWindowSize connFlow minFlow = min strmWindow connWindow n = min len minFlow- when wait $ checkSTM (n > 0)+ when wait $ check (n > 0) if n > 0 then return $ Right n else do
Network/QUIC/Packet/Decode.hs view
@@ -7,9 +7,9 @@ decodeStatelessResetToken, ) where +import qualified Control.Exception as E import qualified Data.ByteString as BS import qualified Data.ByteString.Short as Short-import qualified UnliftIO.Exception as E import Network.QUIC.Imports import Network.QUIC.Packet.Header
Network/QUIC/Receiver.hs view
@@ -5,10 +5,10 @@ receiver, ) where +import qualified Control.Exception as E import qualified Data.ByteString as BS import Network.Control import Network.TLS (AlertDescription (..))-import qualified UnliftIO.Exception as E import Network.QUIC.Config import Network.QUIC.Connection
Network/QUIC/Recovery/Interface.hs view
@@ -7,9 +7,9 @@ resender, ) where +import Control.Concurrent.STM import qualified Data.Sequence as Seq import System.Log.FastLogger (LogStr)-import UnliftIO.STM import Network.QUIC.Imports import Network.QUIC.Qlog@@ -23,12 +23,12 @@ checkWindowOpenSTM :: LDCC -> Int -> STM () checkWindowOpenSTM LDCC{..} siz = do CC{..} <- readTVar recoveryCC- checkSTM (siz <= congestionWindow - bytesInFlight)+ check (siz <= congestionWindow - bytesInFlight) takePingSTM :: LDCC -> STM EncryptionLevel takePingSTM LDCC{..} = do mx <- readTVar ptoPing- checkSTM $ isJust mx+ check $ isJust mx writeTVar ptoPing Nothing return $ fromJust mx @@ -48,7 +48,7 @@ resender ldcc@LDCC{..} = forever $ do atomically $ do lostPackets <- readTVar lostCandidates- checkSTM (lostPackets /= emptySentPackets)+ check (lostPackets /= emptySentPackets) delay $ Microseconds 10000 -- fixme packets <- atomically $ do SentPackets pkts <- readTVar lostCandidates
Network/QUIC/Recovery/LossRecovery.hs view
@@ -8,9 +8,9 @@ onPacketNumberSpaceDiscarded, ) where +import Control.Concurrent.STM import Data.Sequence (Seq, ViewR (..), (|>)) import qualified Data.Sequence as Seq-import UnliftIO.STM import Network.QUIC.Connector import Network.QUIC.Imports
Network/QUIC/Recovery/Metrics.hs view
@@ -9,8 +9,8 @@ setInitialCongestionWindow, ) where +import Control.Concurrent.STM import Data.Sequence (Seq)-import UnliftIO.STM import Network.QUIC.Imports import Network.QUIC.Qlog
Network/QUIC/Recovery/Release.hs view
@@ -7,9 +7,9 @@ onPacketsLost, ) where +import Control.Concurrent.STM import Data.Sequence (Seq, ViewL (..), ViewR (..), (><)) import qualified Data.Sequence as Seq-import UnliftIO.STM import Network.QUIC.Imports import Network.QUIC.Recovery.Metrics
Network/QUIC/Recovery/Timer.hs view
@@ -10,9 +10,9 @@ ldccTimer, ) where +import Control.Concurrent.STM import qualified Data.Sequence as Seq import Network.QUIC.Event-import UnliftIO.STM import Network.QUIC.Connector import Network.QUIC.Imports@@ -116,7 +116,7 @@ ldccTimer ldcc@LDCC{..} = forever $ do atomically $ do x <- readTVar timerInfoQ- checkSTM (x /= Empty)+ check (x /= Empty) delay timerGranularity updateWithNext ldcc
Network/QUIC/Recovery/Types.hs view
@@ -35,13 +35,13 @@ qlogLossTimerExpired, ) where +import Control.Concurrent.STM import Data.IORef import Data.List (intersperse) import Data.Sequence (Seq) import qualified Data.Sequence as Seq import Network.QUIC.Event import System.Log.FastLogger-import UnliftIO.STM import Network.QUIC.Connector import Network.QUIC.Imports
Network/QUIC/Recovery/Utils.hs view
@@ -11,10 +11,10 @@ delay, ) where +import Control.Concurrent+import Control.Concurrent.STM import Data.Sequence (Seq, ViewL (..), (<|)) import qualified Data.Sequence as Seq-import UnliftIO.Concurrent-import UnliftIO.STM import Network.QUIC.Connector import Network.QUIC.Imports
Network/QUIC/Sender.hs view
@@ -6,11 +6,11 @@ sendFinal, ) where +import Control.Concurrent+import Control.Concurrent.STM+import qualified Control.Exception as E import qualified Data.ByteString as BS import Foreign.Ptr (plusPtr)-import UnliftIO.Concurrent-import qualified UnliftIO.Exception as E-import UnliftIO.STM import Network.QUIC.Config import Network.QUIC.Connection
Network/QUIC/Server/Reader.hs view
@@ -17,6 +17,9 @@ recvServer, ) where +import Control.Concurrent+import Control.Concurrent.STM+import qualified Control.Exception as E import qualified Crypto.Token as CT import qualified Data.ByteString as BS import Data.Map.Strict (Map)@@ -28,10 +31,8 @@ import Network.Socket (Socket) import qualified Network.Socket.ByteString as NSB import qualified System.IO.Error as E-import UnliftIO.Concurrent-import qualified UnliftIO.Exception as E-import UnliftIO.STM +import Network.QUIC.Common import Network.QUIC.Config import Network.QUIC.Connection import Network.QUIC.Exception@@ -59,7 +60,11 @@ <*> newIORef emptyRecvQDict <*> newAcceptQ where- conf = CT.defaultConfig{CT.tokenLifetime = scTicketLifetime}+ conf =+ CT.defaultConfig+ { CT.tokenLifetime = scTicketLifetime+ , CT.threadName = "QUIC token manager"+ } clearDispatch :: Dispatch -> IO () clearDispatch d = CT.killTokenManager $ tokenMgr d@@ -144,6 +149,7 @@ dispatcher :: Dispatch -> ServerConfig -> Socket -> IO () dispatcher d conf mysock = handleLogUnit logAction $ do+ labelMe "QUIC dispatcher" forever $ do (peersa, bs, cmsgs, _) <- safeRecv $ NSB.recvMsg mysock 2048 2048 0 now <- getTimeMicrosecond@@ -162,7 +168,7 @@ | otherwise = return () safeRecv rcv = do- ex <- E.tryAny $ windowsThreadBlockHack rcv+ ex <- E.try $ windowsThreadBlockHack rcv case ex of Right x -> return x Left se -> case E.fromException se of
Network/QUIC/Server/Run.hs view
@@ -8,11 +8,11 @@ stop, ) where +import Control.Concurrent+import Control.Concurrent.Async+import qualified Control.Exception as E import qualified Network.Socket as NS import System.Log.FastLogger-import UnliftIO.Async-import UnliftIO.Concurrent-import qualified UnliftIO.Exception as E import Network.QUIC.Closer import Network.QUIC.Common@@ -41,6 +41,7 @@ -- in a new lightweight thread. run :: ServerConfig -> (Connection -> IO ()) -> IO () run conf server = NS.withSocketsDo $ handleLogUnit debugLog $ do+ labelMe "QUIC run" baseThreadId <- myThreadId E.bracket setup teardown $ \(dispatch, _, _) -> do onServerReady $ scHooks conf@@ -68,6 +69,7 @@ -- in a new lightweight thread. runWithSockets :: [NS.Socket] -> ServerConfig -> (Connection -> IO ()) -> IO () runWithSockets ssas conf server = NS.withSocketsDo $ handleLogUnit debugLog $ do+ labelMe "QUIC runWithSockets" baseThreadId <- myThreadId E.bracket setup teardown $ \(dispatch, _) -> do onServerReady $ scHooks conf@@ -92,7 +94,8 @@ -- And the exception should be ignored. runServer :: ServerConfig -> (Connection -> IO ()) -> Dispatch -> ThreadId -> Accept -> IO ()-runServer conf server0 dispatch baseThreadId acc =+runServer conf server0 dispatch baseThreadId acc = do+ labelMe "QUIC runServer" E.bracket open clse $ \(ConnRes conn myAuthCIDs _reader) -> handleLogUnit (debugLog conn) $ do let conf' =@@ -108,21 +111,22 @@ afterHandshakeServer conf conn server0 conn ldcc = connLDCC conn- supporters =- foldr1- concurrently_- [ handshaker- , sender conn- , receiver conn- , resender ldcc- , ldccTimer ldcc- ]+ let s1 = labelMe "handshaker" >> handshaker+ s2 = labelMe "sender" >> sender conn+ s3 = labelMe "receiver" >> receiver conn+ s4 = labelMe "resender" >> resender ldcc+ s5 = labelMe "ldccTimer" >> ldccTimer ldcc+ c1 = labelMe "concurrently1" >> concurrently_ s1 s2+ c2 = labelMe "concurrently2" >> concurrently_ c1 s3+ c3 = labelMe "concurrently3" >> concurrently_ c2 s4+ c4 = labelMe "concurrently4" >> concurrently_ c3 s5+ supporters = c4 runThreads = do- er <- race supporters server+ er <- race supporters (labelMe "QUIC server" >> server) case er of Left () -> E.throwIO MustNotReached Right r -> return r- ex <- E.trySyncOrAsync runThreads+ ex <- E.try runThreads sendFinal conn closure conn ldcc ex where
Network/QUIC/Socket.hs view
@@ -4,9 +4,9 @@ natRebinding, ) where +import qualified Control.Exception as E import Data.IP (IP, toSockAddr) import Network.Socket-import qualified UnliftIO.Exception as E natRebinding :: SockAddr -> IO Socket natRebinding sa = E.bracketOnError open close return
Network/QUIC/Stream/Misc.hs view
@@ -18,8 +18,8 @@ updateStreamFlowRx, ) where +import Control.Concurrent.STM import Network.Control-import UnliftIO.STM import Network.QUIC.Imports import Network.QUIC.Stream.Queue
Network/QUIC/Stream/Queue.hs view
@@ -2,8 +2,8 @@ module Network.QUIC.Stream.Queue where +import Control.Concurrent.STM import Data.ByteString (ByteString)-import UnliftIO.STM import Network.QUIC.Stream.Types
Network/QUIC/Stream/Types.hs view
@@ -12,10 +12,10 @@ waitFinTx, ) where +import Control.Concurrent+import Control.Concurrent.STM import qualified Data.ByteString as BS import Network.Control-import UnliftIO.Concurrent-import UnliftIO.STM import {-# SOURCE #-} Network.QUIC.Connection.Types import Network.QUIC.Imports
Network/QUIC/TLS.hs view
@@ -7,8 +7,8 @@ ) where import Control.Applicative ((<|>))-import Data.Default.Class-import Network.TLS hiding (Version)+import Data.Default+import Network.TLS hiding (Version, defaultSupported) import Network.TLS.QUIC import System.X509
Network/QUIC/Types/Exception.hs view
@@ -1,7 +1,7 @@ module Network.QUIC.Types.Exception where +import qualified Control.Exception as E import qualified Network.TLS as TLS-import qualified UnliftIO.Exception as E import Network.QUIC.Imports import Network.QUIC.Types.Error
Network/QUIC/Types/Queue.hs view
@@ -1,6 +1,6 @@ module Network.QUIC.Types.Queue where -import UnliftIO.STM+import Control.Concurrent.STM import Network.QUIC.Types.Packet
Network/QUIC/Utils.hs view
@@ -2,6 +2,7 @@ module Network.QUIC.Utils where +import Control.Exception import Control.Monad (replicateM) import qualified Data.ByteString as BS import Data.ByteString.Base16@@ -15,7 +16,6 @@ import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (Ptr, plusPtr) import System.Random (randomIO)-import UnliftIO.Exception -- GHC 8.0 does not provide fromRight. fromRight :: b -> Either a b -> b
quic.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: quic-version: 0.2.2+version: 0.2.3 license: BSD3 license-file: LICENSE maintainer: kazu@iij.ad.jp@@ -128,18 +128,19 @@ ghc-options: -Wall -Wcompat build-depends: base >=4.9 && <5,+ async, array >= 0.5 && < 0.6, base16-bytestring >= 1.0 && < 1.1, bytestring >= 0.10,- containers >= 0.6 && < 0.7,- crypto-token >= 0.1.1 && < 0.2,+ containers,+ crypto-token >= 0.1.2 && < 0.2, crypton >= 0.34, memory >= 0.18.0 && < 0.19, crypton-x509 >= 1.7.6 && < 1.8, crypton-x509-system >= 1.6.7 && < 1.7,- filepath >= 1.4 && < 1.5,+ filepath, stm >= 2.5 && < 2.6,- data-default-class >= 0.1.2 && < 0.2,+ data-default, fast-logger >= 3.2.2 && < 3.3, unix-time >= 0.4.12 && < 0.5, iproute >= 1.7.12 && < 1.8,@@ -148,9 +149,7 @@ network-control >= 0.1 && < 0.2, random >= 1.2.1 && < 1.3, serialise,- tls >= 2.0 && < 2.2,- unliftio >= 0.2 && < 0.3,- unliftio-core >= 0.2 && < 0.3+ tls >= 2.0 && < 2.2 if os(windows) cc-options: -D_WINDOWS@@ -182,8 +181,7 @@ network-byte-order, quic, tls,- tls-session-manager >= 0.0.5,- unliftio+ tls-session-manager >= 0.0.5 if flag(devel) @@ -214,8 +212,7 @@ network-byte-order, quic, tls,- unix-time,- unliftio+ unix-time if flag(devel) @@ -257,8 +254,7 @@ network >=3.1.2, quic, tls,- unix-time,- unliftio+ unix-time if os(windows) ghc-options: -with-rtsopts=--io-manager=native
test/Config.hs view
@@ -12,6 +12,8 @@ newSessionManager, ) where +import Control.Concurrent+import qualified Control.Exception as E import Control.Monad import Data.ByteString (ByteString) import Data.IORef@@ -19,8 +21,6 @@ import Network.Socket import Network.Socket.ByteString import Network.TLS hiding (Version)-import UnliftIO.Concurrent-import qualified UnliftIO.Exception as E import Network.QUIC.Client import Network.QUIC.Internal
test/ErrorSpec.hs view
@@ -1,11 +1,11 @@ module ErrorSpec where +import Control.Concurrent import Control.Monad (forever, void) import Data.ByteString () import Network.QUIC import Network.QUIC.Server import Test.Hspec-import UnliftIO.Concurrent import Config import TransportError
test/FrameSpec.hs view
@@ -1,12 +1,12 @@ module FrameSpec where +import qualified Control.Exception as E import Data.Word import Foreign.Marshal.Alloc import Foreign.Marshal.Utils (fillBytes) import Foreign.Ptr import Foreign.Storable import Test.Hspec-import qualified UnliftIO.Exception as E import Network.QUIC.Internal
test/HandshakeSpec.hs view
@@ -2,13 +2,13 @@ module HandshakeSpec where +import Control.Concurrent+import qualified Control.Exception as E import Control.Monad import qualified Data.ByteString as BS import Network.TLS (Group (..), HandshakeMode13 (..)) import qualified Network.TLS as TLS import Test.Hspec-import UnliftIO.Concurrent-import qualified UnliftIO.Exception as E import Network.QUIC import Network.QUIC.Client as C
test/IOSpec.hs view
@@ -2,12 +2,12 @@ module IOSpec where +import Control.Concurrent+import Control.Concurrent.Async+import qualified Control.Exception as E 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
test/TransportError.hs view
@@ -4,14 +4,14 @@ transportErrorSpec, ) where +import Control.Concurrent import Control.Monad import Data.ByteString () import qualified Data.ByteString as BS import qualified Network.TLS as TLS import Network.TLS.QUIC (ExtensionID (..), ExtensionRaw (..))+import System.Timeout import Test.Hspec-import UnliftIO.Concurrent-import UnliftIO.Timeout import Network.QUIC.Client import Network.QUIC.Internal hiding (timeout)
util/ServerX.hs view
@@ -3,11 +3,11 @@ module ServerX where import Control.Concurrent+import qualified Control.Exception as E import Control.Monad import qualified Data.ByteString as BS import Data.ByteString.Builder import Network.ByteOrder-import qualified UnliftIO.Exception as E import H3 import Network.QUIC
util/quic-client.hs view
@@ -17,8 +17,8 @@ import System.Environment import System.Exit import System.IO+import qualified System.Timeout as T import Text.Printf-import qualified UnliftIO.Timeout as T import ClientX import Common