diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,12 @@ # ChangeLog +## 0.2.0 + +* A new server architecture: only wildcard (unconnected) sockets are used. + [#66](https://github.com/kazu-yamamoto/quic/pull/66) +* Breaking change: `ccAutoMigration` is removed. Clients always use + unconnected sockets. + ## 0.1.28 * Fixing a bug of quic bit. diff --git a/Network/QUIC.hs b/Network/QUIC.hs --- a/Network/QUIC.hs +++ b/Network/QUIC.hs @@ -36,12 +36,23 @@ sendStreamMany, -- * Information - ConnectionInfo (..), + ConnectionInfo, getConnectionInfo, + version, + cipher, + alpn, + handshakeMode, + retry, + localSockAddr, + remoteSockAddr, + localCID, + remoteCID, -- * Statistics - ConnectionStats (..), + ConnectionStats, getConnectionStats, + txBytes, + rxBytes, -- * Synchronization wait0RTTReady, diff --git a/Network/QUIC/Client.hs b/Network/QUIC/Client.hs --- a/Network/QUIC/Client.hs +++ b/Network/QUIC/Client.hs @@ -18,7 +18,6 @@ ccVersions, -- , ccCredentials ccValidate, - ccAutoMigration, -- * Resumption ResumptionInfo, diff --git a/Network/QUIC/Client/Reader.hs b/Network/QUIC/Client/Reader.hs --- a/Network/QUIC/Client/Reader.hs +++ b/Network/QUIC/Client/Reader.hs @@ -6,11 +6,12 @@ recvClient, ConnectionControl (..), controlConnection, + clientSocket, ) where import Data.List (intersect) -import Network.Socket (getSocketName) -import Network.UDP +import Network.Socket (Socket, close, getSocketName) +import Network.Socket.ByteString (recvFrom) import UnliftIO.Concurrent import qualified UnliftIO.Exception as E @@ -23,11 +24,12 @@ import Network.QUIC.Parameters import Network.QUIC.Qlog import Network.QUIC.Recovery +import Network.QUIC.Socket import Network.QUIC.Types -- | readerClient dies when the socket is closed. -readerClient :: UDPSocket -> Connection -> IO () -readerClient cs0@(UDPSocket s0 _ _) conn = handleLogUnit logAction $ do +readerClient :: Socket -> Connection -> IO () +readerClient s0 conn = handleLogUnit logAction $ do wait loop where @@ -42,10 +44,11 @@ ito <- readMinIdleTimeout conn mbs <- timeout ito "readeClient" $ - recv cs0 + recvFrom s0 2048 -- fixme case mbs of - Nothing -> close cs0 - Just bs -> do + Nothing -> close s0 + Just (bs, peersa) -> do + setPeerSockAddr conn peersa now <- getTimeMicrosecond let quicBit = greaseQuicBit $ getMyParameters conn pkts <- decodePackets bs (not quicBit) @@ -139,10 +142,9 @@ rebind :: Connection -> Microseconds -> IO () rebind conn microseconds = do - cs0 <- getSocket conn - cs <- natRebinding cs0 - cs0' <- setSocket conn cs - let reader = readerClient cs conn + peersa <- getPeerSockAddr conn + newSock <- natRebinding peersa + oldSock <- setSocket conn newSock + let reader = readerClient newSock conn forkIO reader >>= addReader conn - -- Using cs0' just in case. - fire conn microseconds $ close cs0' + fire conn microseconds $ close oldSock 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 @@ -8,8 +8,6 @@ ) where import qualified Network.Socket as NS -import Network.UDP (UDPSocket (..)) -import qualified Network.UDP as UDP import UnliftIO.Async import UnliftIO.Concurrent import qualified UnliftIO.Exception as E @@ -107,13 +105,14 @@ createClientConnection :: ClientConfig -> VersionInfo -> IO ConnRes createClientConnection conf@ClientConfig{..} verInfo = do - us@(UDPSocket _ sa _) <- - UDP.clientSocket ccServerName ccPortName (not ccAutoMigration) + (sock, peersa) <- clientSocket ccServerName ccPortName q <- newRecvQ - sref <- newIORef us + sref <- newIORef sock + psaref <- newIORef peersa let send = \buf siz -> do - cs <- readIORef sref - UDP.sendBuf cs buf siz + s <- readIORef sref + sa <- readIORef psaref + void $ NS.sendBufTo s buf siz sa recv = recvClient q myCID <- newCID peerCID <- newCID @@ -135,6 +134,7 @@ qLog ccHooks sref + psaref q send recv @@ -143,16 +143,14 @@ initializeCoder conn InitialLevel $ initialSecrets ver peerCID setupCryptoStreams conn -- fixme: cleanup let pktSiz0 = fromMaybe 0 ccPacketSize - pktSiz = (defaultPacketSize sa `max` pktSiz0) `min` maximumPacketSize sa + pktSiz = (defaultPacketSize peersa `max` pktSiz0) `min` maximumPacketSize peersa setMaxPacketSize conn pktSiz setInitialCongestionWindow (connLDCC conn) pktSiz setAddressValidated conn - let reader = readerClient us conn -- dies when s0 is closed. + let reader = readerClient sock conn -- dies when s0 is closed. return $ ConnRes conn myAuthCIDs reader -- | Creating a new socket and execute a path validation --- with a new connection ID. Typically, this is used --- for migration in the case where 'ccAutoMigration' is 'False'. --- But this can also be used even when the value is 'True'. +-- with a new connection ID. migrate :: Connection -> IO Bool migrate conn = controlConnection conn ActiveMigration diff --git a/Network/QUIC/Closer.hs b/Network/QUIC/Closer.hs --- a/Network/QUIC/Closer.hs +++ b/Network/QUIC/Closer.hs @@ -1,11 +1,10 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Network.QUIC.Closer (closure) where import Foreign.Marshal.Alloc import Foreign.Ptr -import qualified Network.UDP as UDP +import qualified Network.Socket as NS import UnliftIO.Concurrent import qualified UnliftIO.Exception as E @@ -39,27 +38,35 @@ closure' :: Connection -> LDCC -> Frame -> IO () closure' conn ldcc frame = do - killReaders conn - let bufsiz = maximumUdpPayloadSize - sendBuf <- mallocBytes bufsiz - recvBuf <- mallocBytes bufsiz - siz <- encodeCC conn (SizedBuffer sendBuf bufsiz) frame - us <- getSocket conn - let clos = do - UDP.close us - -- This is just in case. - -- UDP.close never throw exceptions. - getSocket conn >>= UDP.close - send = UDP.sendBuf us sendBuf siz - recv = UDP.recvBuf us recvBuf bufsiz - hook = onCloseCompleted $ connHooks conn + sock <- getSocket conn + peersa <- getPeerSockAddr conn + -- send + let sbuf@(SizedBuffer sendBuf _) = encryptRes conn + siz <- encodeCC conn sbuf frame + let send = void $ NS.sendBufTo sock sendBuf siz peersa + -- recv and clos + killReaders conn -- client only + (recv, freeRecvBuf, clos) <- + if isServer conn + then return (void $ connRecv conn, return (), return ()) + else do + let bufsiz = maximumUdpPayloadSize + recvBuf <- mallocBytes bufsiz + let recv' = void $ NS.recvBuf sock recvBuf bufsiz + free' = free recvBuf + clos' = do + NS.close sock + -- This is just in case. + getSocket conn >>= NS.close + return (recv', free', clos') + -- hook + let hook = onCloseCompleted $ connHooks conn pto <- getPTO ldcc void $ forkFinally (closer conn pto send recv hook) $ \e -> do case e of Left e' -> connDebugLog conn $ "closure' " <> bhow e' Right _ -> return () - free sendBuf - free recvBuf + freeRecvBuf clos encodeCC :: Connection -> SizedBuffer -> Frame -> IO Int @@ -93,12 +100,8 @@ else return 0 -closer :: Connection -> Microseconds -> IO () -> IO Int -> IO () -> IO () -closer _conn (Microseconds pto) send recv hook -#if defined(mingw32_HOST_OS) - | isServer _conn = send -#endif - | otherwise = loop (3 :: Int) +closer :: Connection -> Microseconds -> IO () -> IO () -> IO () -> IO () +closer _conn (Microseconds pto) send recv hook = loop (3 :: Int) where loop 0 = return () loop n = do @@ -107,14 +110,12 @@ mx <- timeout (Microseconds (pto !>>. 1)) "closer 1" recv case mx of Nothing -> hook - Just 0 -> return () - Just _ -> loop (n - 1) + Just () -> loop (n - 1) skip tmo@(Microseconds duration) base = do mx <- timeout tmo "closer 2" recv case mx of Nothing -> return () - Just 0 -> return () - Just _ -> do + Just () -> do Microseconds elapsed <- getElapsedTimeMicrosecond base let duration' = duration - elapsed when (duration' >= 5000) $ skip (Microseconds duration') base diff --git a/Network/QUIC/Config.hs b/Network/QUIC/Config.hs --- a/Network/QUIC/Config.hs +++ b/Network/QUIC/Config.hs @@ -80,8 +80,6 @@ , ccPacketSize :: Maybe Int -- ^ QUIC packet size (UDP payload size) , ccDebugLog :: Bool - , ccAutoMigration :: Bool - -- ^ If 'True', use a unconnected socket for auto migration. Otherwise, use a connected socket. } -- | The default value for client configuration. @@ -107,7 +105,6 @@ , ccResumption = defaultResumptionInfo , ccPacketSize = Nothing , ccDebugLog = False - , ccAutoMigration = True } ---------------------------------------------------------------- diff --git a/Network/QUIC/Connection/Misc.hs b/Network/QUIC/Connection/Misc.hs --- a/Network/QUIC/Connection/Misc.hs +++ b/Network/QUIC/Connection/Misc.hs @@ -10,6 +10,8 @@ getSocket, setSocket, clearSocket, + getPeerSockAddr, + setPeerSockAddr, getPeerAuthCIDs, setPeerAuthCIDs, getClientDstCID, @@ -31,7 +33,7 @@ abortConnection, ) where -import Network.UDP +import Network.Socket (SockAddr, Socket) import System.Mem.Weak import UnliftIO.Concurrent import qualified UnliftIO.Exception as E @@ -64,15 +66,22 @@ ---------------------------------------------------------------- -getSocket :: Connection -> IO UDPSocket -getSocket Connection{..} = readIORef udpSocket +getSocket :: Connection -> IO Socket +getSocket Connection{..} = readIORef connSocket -setSocket :: Connection -> UDPSocket -> IO UDPSocket -setSocket Connection{..} sock = atomicModifyIORef' udpSocket $ +setSocket :: Connection -> Socket -> IO Socket +setSocket Connection{..} sock = atomicModifyIORef' connSocket $ \sock0 -> (sock, sock0) -clearSocket :: Connection -> IO UDPSocket -clearSocket Connection{..} = atomicModifyIORef' udpSocket (undefined,) +-- fixme +clearSocket :: Connection -> IO Socket +clearSocket Connection{..} = atomicModifyIORef' connSocket (undefined,) + +getPeerSockAddr :: Connection -> IO SockAddr +getPeerSockAddr Connection{..} = readIORef peerSockAddr + +setPeerSockAddr :: Connection -> SockAddr -> IO () +setPeerSockAddr Connection{..} sa = writeIORef peerSockAddr sa ---------------------------------------------------------------- diff --git a/Network/QUIC/Connection/Types.hs b/Network/QUIC/Connection/Types.hs --- a/Network/QUIC/Connection/Types.hs +++ b/Network/QUIC/Connection/Types.hs @@ -16,8 +16,8 @@ import Foreign.Marshal.Alloc import Foreign.Ptr (nullPtr) import Network.Control (Rate, RxFlow, TxFlow, newRate, newRxFlow, newTxFlow) +import Network.Socket (SockAddr, Socket) import Network.TLS.QUIC -import Network.UDP (UDPSocket) import UnliftIO.Concurrent import UnliftIO.STM @@ -199,7 +199,7 @@ , connRecv :: ~Recv -- ~ for testing -- Manage , connRecvQ :: RecvQ - , udpSocket :: ~(IORef UDPSocket) + , connSocket :: IORef Socket , readers :: IORef (IO ()) , mainThreadId :: ThreadId , controlRate :: Rate @@ -213,6 +213,7 @@ , -- Peer peerParameters :: IORef Parameters , peerCIDDB :: TVar CIDDB + , peerSockAddr :: IORef SockAddr , -- Queues inputQ :: InputQ , cryptoQ :: CryptoQ @@ -287,12 +288,14 @@ -> DebugLogger -> QLogger -> Hooks - -> IORef UDPSocket + -> IORef Socket + -> IORef SockAddr -> RecvQ -> Send -> Recv -> IO Connection -newConnection rl myparams verInfo myAuthCIDs peerAuthCIDs debugLog qLog hooks sref recvQ ~send ~recv = do +newConnection rl myparams verInfo myAuthCIDs peerAuthCIDs debugLog qLog hooks sref psaref recvQ ~send ~recv = do + -- ~ for testing outQ <- newTQueueIO let put x = atomically $ writeTQueue outQ $ OutRetrans x connstate <- newConnState rl @@ -314,6 +317,7 @@ -- Peer <*> newIORef baseParameters <*> newTVarIO (newCIDDB peerCID) + <*> return psaref -- Queues <*> newTQueueIO <*> newTQueueIO @@ -380,7 +384,8 @@ -> DebugLogger -> QLogger -> Hooks - -> IORef UDPSocket + -> IORef Socket + -> IORef SockAddr -> RecvQ -> Send -> Recv @@ -396,7 +401,8 @@ -> DebugLogger -> QLogger -> Hooks - -> IORef UDPSocket + -> IORef Socket + -> IORef SockAddr -> RecvQ -> Send -> Recv diff --git a/Network/QUIC/Info.hs b/Network/QUIC/Info.hs --- a/Network/QUIC/Info.hs +++ b/Network/QUIC/Info.hs @@ -8,15 +8,16 @@ import Network.QUIC.Types import Network.QUIC.Types.Info import qualified Network.Socket as NS -import Network.UDP (UDPSocket (..)) ---------------------------------------------------------------- -- | Getting information about a connection. getConnectionInfo :: Connection -> IO ConnectionInfo getConnectionInfo conn = do - UDPSocket{..} <- getSocket conn - mysa <- NS.getSocketName udpSocket + sock <- getSocket conn + -- fixme: this is undefined + mysa <- NS.getSocketName sock + peersa <- getPeerSockAddr conn mycid <- getMyCID conn peercid <- getPeerCID conn c <- getCipher conn RTT1Level @@ -32,7 +33,7 @@ , handshakeMode = mode , retry = r , localSockAddr = mysa - , remoteSockAddr = peerSockAddr + , remoteSockAddr = peersa , localCID = mycid , remoteCID = peercid } diff --git a/Network/QUIC/Internal.hs b/Network/QUIC/Internal.hs --- a/Network/QUIC/Internal.hs +++ b/Network/QUIC/Internal.hs @@ -14,6 +14,7 @@ module Network.QUIC.Recovery, module Network.QUIC.Client.Reader, module Network.QUIC.Windows, + module Network.QUIC.Socket, ) where import Network.QUIC.Client.Reader (ConnectionControl (..), controlConnection) @@ -26,6 +27,7 @@ import Network.QUIC.Parameters import Network.QUIC.Qlog import Network.QUIC.Recovery +import Network.QUIC.Socket import Network.QUIC.Stream import Network.QUIC.TLS import Network.QUIC.Types diff --git a/Network/QUIC/Packet/Decode.hs b/Network/QUIC/Packet/Decode.hs --- a/Network/QUIC/Packet/Decode.hs +++ b/Network/QUIC/Packet/Decode.hs @@ -93,7 +93,7 @@ len <- remainingSize rbuf here <- savingSize rbuf ff rbuf len - return $ Crypt here bs 0 Nothing + return $ Crypt here bs 0 makeLongCrypt :: ByteString -> ReadBuffer -> IO Crypt makeLongCrypt bs rbuf = do @@ -101,7 +101,7 @@ here <- savingSize rbuf ff rbuf len let pkt = BS.take (here + len) bs - return $ Crypt here pkt 0 Nothing + return $ Crypt here pkt 0 ---------------------------------------------------------------- diff --git a/Network/QUIC/Receiver.hs b/Network/QUIC/Receiver.hs --- a/Network/QUIC/Receiver.hs +++ b/Network/QUIC/Receiver.hs @@ -8,7 +8,6 @@ import qualified Data.ByteString as BS import Network.Control import Network.TLS (AlertDescription (..)) -import UnliftIO.Concurrent (forkIO) import qualified UnliftIO.Exception as E import Network.QUIC.Config @@ -23,7 +22,6 @@ import Network.QUIC.Parameters import Network.QUIC.Qlog import Network.QUIC.Recovery -import Network.QUIC.Server.Reader (runNewServerReader) import Network.QUIC.Stream import Network.QUIC.Types as QUIC @@ -163,10 +161,6 @@ when (lvl == RTT1Level) $ setPeerPacketNumber conn plainPacketNumber qlogReceived conn (PlainPacket hdr plain) tim let ackEli = any ackEliciting plainFrames - case cryptMigraionInfo crypt of - Nothing -> return () - Just miginfo -> - void . forkIO $ runNewServerReader conn miginfo (ckp, cpn) <- getCurrentKeyPhase conn let Flags flags = plainFlags nkp = flags `testBit` 2 diff --git a/Network/QUIC/Server/Reader.hs b/Network/QUIC/Server/Reader.hs --- a/Network/QUIC/Server/Reader.hs +++ b/Network/QUIC/Server/Reader.hs @@ -1,24 +1,22 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Network.QUIC.Server.Reader ( - Dispatch - , newDispatch - , clearDispatch - , runDispatcher - , tokenMgr - -- * Accepting - , accept - , Accept(..) - -- * Receiving and reading - , RecvQ - , recvServer - , readerServer - -- * Misc - , runNewServerReader - ) where + Dispatch, + newDispatch, + clearDispatch, + runDispatcher, + tokenMgr, + -- * Accepting + accept, + Accept (..), + + -- * Receiving and reading + RecvQ, + recvServer, +) where + import qualified Crypto.Token as CT import qualified Data.ByteString as BS import Data.Map.Strict (Map) @@ -27,10 +25,9 @@ import Network.ByteOrder import Network.Control (LRUCache) import qualified Network.Control as LRUCache -import Network.UDP (ListenSocket, UDPSocket, ClientSockAddr) -import qualified Network.UDP as UDP +import Network.Socket (SockAddr, Socket) +import qualified Network.Socket.ByteString as NSB import qualified System.IO.Error as E -import System.Log.FastLogger import UnliftIO.Concurrent import qualified UnliftIO.Exception as E import UnliftIO.STM @@ -42,31 +39,27 @@ import Network.QUIC.Logger import Network.QUIC.Packet import Network.QUIC.Parameters -import Network.QUIC.Qlog import Network.QUIC.Types -#if defined(mingw32_HOST_OS) import Network.QUIC.Windows -#else -import Network.QUIC.Connector -#endif ---------------------------------------------------------------- -data Dispatch = Dispatch { - tokenMgr :: CT.TokenManager - , dstTable :: IORef ConnectionDict - , srcTable :: IORef RecvQDict - , acceptQ :: AcceptQ - } +data Dispatch = Dispatch + { tokenMgr :: CT.TokenManager + , dstTable :: IORef ConnectionDict + , srcTable :: IORef RecvQDict + , acceptQ :: AcceptQ + } newDispatch :: ServerConfig -> IO Dispatch newDispatch ServerConfig{..} = - Dispatch <$> CT.spawnTokenManager conf - <*> newIORef emptyConnectionDict - <*> newIORef emptyRecvQDict - <*> newAcceptQ + Dispatch + <$> CT.spawnTokenManager conf + <*> newIORef emptyConnectionDict + <*> newIORef emptyRecvQDict + <*> newAcceptQ where - conf = CT.defaultConfig { CT.tokenLifetime = scTicketLifetime } + conf = CT.defaultConfig{CT.tokenLifetime = scTicketLifetime} clearDispatch :: Dispatch -> IO () clearDispatch d = CT.killTokenManager $ tokenMgr d @@ -94,7 +87,7 @@ ---------------------------------------------------------------- -- Original destination CID -> RecvQ -data RecvQDict = RecvQDict(LRUCache CID RecvQ) +data RecvQDict = RecvQDict (LRUCache CID RecvQ) recvQDictSize :: Int recvQDictSize = 100 @@ -106,8 +99,8 @@ lookupRecvQDict ref dcid = do RecvQDict c <- readIORef ref return $ case LRUCache.lookup dcid c of - Nothing -> Nothing - Just q -> Just q + Nothing -> Nothing + Just q -> Just q insertRecvQDict :: IORef RecvQDict -> CID -> RecvQ -> IO () insertRecvQDict ref dcid q = atomicModifyIORef'' ref ins @@ -116,19 +109,19 @@ ---------------------------------------------------------------- -data Accept = Accept { - accVersionInfo :: VersionInfo - , accMyAuthCIDs :: AuthCIDs - , accPeerAuthCIDs :: AuthCIDs - , accMySocket :: ListenSocket - , accPeerSockAddr :: ClientSockAddr - , accRecvQ :: RecvQ - , accPacketSize :: Int - , accRegister :: CID -> Connection -> IO () - , accUnregister :: CID -> IO () - , accAddressValidated :: Bool - , accTime :: TimeMicrosecond - } +data Accept = Accept + { accVersionInfo :: VersionInfo + , accMyAuthCIDs :: AuthCIDs + , accPeerAuthCIDs :: AuthCIDs + , accMySocket :: Socket + , accPeerSockAddr :: SockAddr + , accRecvQ :: RecvQ + , accPacketSize :: Int + , accRegister :: CID -> Connection -> IO () + , accUnregister :: CID -> IO () + , accAddressValidated :: Bool + , accTime :: TimeMicrosecond + } newtype AcceptQ = AcceptQ (TQueue Accept) @@ -146,37 +139,36 @@ ---------------------------------------------------------------- -runDispatcher :: Dispatch -> ServerConfig -> ListenSocket -> IO ThreadId +runDispatcher :: Dispatch -> ServerConfig -> Socket -> IO ThreadId runDispatcher d conf mysock = forkIO $ dispatcher d conf mysock -dispatcher :: Dispatch -> ServerConfig -> ListenSocket -> IO () +dispatcher :: Dispatch -> ServerConfig -> Socket -> IO () dispatcher d conf mysock = handleLogUnit logAction $ do forever $ do - (bs, peersa) <- safeRecv $ UDP.recvFrom mysock + (bs, peersa) <- safeRecv $ NSB.recvFrom mysock 2048 now <- getTimeMicrosecond - let send' b = UDP.sendTo mysock b peersa - cpckts <- decodeCryptPackets bs True + let send' b = void $ NSB.sendTo mysock b peersa + -- cf: greaseQuicBit $ getMyParameters conn + quicBit = greaseQuicBit $ scParameters conf + cpckts <- decodeCryptPackets bs (not quicBit) let bytes = BS.length bs switch = dispatch d conf logAction mysock peersa send' bytes now mapM_ switch cpckts where doDebug = isJust $ scDebugLog conf - logAction msg | doDebug = stdoutLogger ("dispatch(er): " <> msg) - | otherwise = return () + logAction msg + | doDebug = stdoutLogger ("dispatch(er): " <> msg) + | otherwise = return () safeRecv rcv = do - ex <- E.tryAny $ -#if defined(mingw32_HOST_OS) - windowsThreadBlockHack $ -#endif - rcv + ex <- E.tryAny $ windowsThreadBlockHack rcv case ex of - Right x -> return x - Left se -> case E.fromException se of - Just e | E.ioeGetErrorType e == E.InvalidArgument -> E.throwIO se - _ -> do - logAction $ "recv again: " <> bhow se - rcv + Right x -> return x + Left se -> case E.fromException se of + Just e | E.ioeGetErrorType e == E.InvalidArgument -> E.throwIO se + _ -> do + logAction $ "recv again: " <> bhow se + rcv ---------------------------------------------------------------- @@ -187,218 +179,183 @@ -- retransmitted. -- For the other fragments, handshake will fail since its socket -- cannot be connected. -dispatch :: Dispatch -> ServerConfig -> DebugLogger - -> ListenSocket -> ClientSockAddr -> (ByteString -> IO ()) -> Int -> TimeMicrosecond - -> (CryptPacket,EncryptionLevel,Int) - -> IO () -dispatch Dispatch{..} ServerConfig{..} logAction - mysock peersa send' bytes tim - (cpkt@(CryptPacket (Initial peerVer dCID sCID token) _),lvl,siz) - | bytes < defaultQUICPacketSize = do - logAction $ "too small " <> bhow bytes <> ", " <> bhow peersa - | peerVer `notElem` myVersions = do - let offerVersions - | peerVer == GreasingVersion = GreasingVersion2 : myVersions - | otherwise = GreasingVersion : myVersions - bss <- encodeVersionNegotiationPacket $ VersionNegotiationPacket sCID dCID offerVersions - send' bss - | token == "" = do - mconn <- lookupConnectionDict dstTable dCID - case mconn of - Nothing - | scRequireRetry -> sendRetry - | otherwise -> pushToAcceptFirst False -#if defined(mingw32_HOST_OS) - Just conn -> writeRecvQ (connRecvQ conn) $ mkReceivedPacket cpkt tim siz lvl -#else - _ -> return () -#endif - | otherwise = do - mct <- decryptToken tokenMgr token - case mct of - Just ct - | isRetryToken ct -> do - ok <- isRetryTokenValid ct - if ok then pushToAcceptRetried ct else sendRetry - | otherwise -> do - mconn <- lookupConnectionDict dstTable dCID - case mconn of - Nothing -> pushToAcceptFirst True -#if defined(mingw32_HOST_OS) - Just conn -> writeRecvQ (connRecvQ conn) $ mkReceivedPacket cpkt tim siz lvl -#else - _ -> return () -#endif - _ -> sendRetry - where - myVersions = scVersions - pushToAcceptQ myAuthCIDs peerAuthCIDs key addrValid = do - mq <- lookupRecvQDict srcTable key - case mq of - Just q -> writeRecvQ q $ mkReceivedPacket cpkt tim siz lvl - Nothing -> do - q <- newRecvQ - insertRecvQDict srcTable key q - writeRecvQ q $ mkReceivedPacket cpkt tim siz lvl - let reg = registerConnectionDict dstTable - unreg = unregisterConnectionDict dstTable - ent = Accept { - accVersionInfo = VersionInfo peerVer myVersions - , accMyAuthCIDs = myAuthCIDs - , accPeerAuthCIDs = peerAuthCIDs - , accMySocket = mysock - , accPeerSockAddr = peersa - , accRecvQ = q - , accPacketSize = bytes - , accRegister = reg - , accUnregister = unreg - , accAddressValidated = addrValid - , accTime = tim - } - -- fixme: check acceptQ length - writeAcceptQ acceptQ ent - -- Initial: DCID=S1, SCID=C1 -> - -- <- Initial: DCID=C1, SCID=S2 - -- ... - -- 1-RTT: DCID=S2 -> - -- <- 1-RTT: DCID=C1 - -- - -- initial_source_connection_id = S2 (newdCID) - -- original_destination_connection_id = S1 (dCID) - -- retry_source_connection_id = Nothing - pushToAcceptFirst addrValid = do - newdCID <- newCID - let myAuthCIDs = defaultAuthCIDs { - initSrcCID = Just newdCID - , origDstCID = Just dCID - } - peerAuthCIDs = defaultAuthCIDs { - initSrcCID = Just sCID - } - pushToAcceptQ myAuthCIDs peerAuthCIDs dCID addrValid - -- Initial: DCID=S1, SCID=C1 -> - -- <- Retry: DCID=C1, SCID=S2 - -- Initial: DCID=S2, SCID=C1 -> - -- <- Initial: DCID=C1, SCID=S3 - -- ... - -- 1-RTT: DCID=S3 -> - -- <- 1-RTT: DCID=C1 - -- - -- initial_source_connection_id = S3 (dCID) S2 in our server - -- original_destination_connection_id = S1 (o) - -- retry_source_connection_id = S2 (dCID) - pushToAcceptRetried (CryptoToken _ _ _ (Just (_,_,o))) = do - let myAuthCIDs = defaultAuthCIDs { - initSrcCID = Just dCID - , origDstCID = Just o - , retrySrcCID = Just dCID - } - peerAuthCIDs = defaultAuthCIDs { - initSrcCID = Just sCID - } - pushToAcceptQ myAuthCIDs peerAuthCIDs o True - pushToAcceptRetried _ = return () - isRetryTokenValid (CryptoToken _tver life etim (Just (l,r,_))) = do - diff <- getElapsedTimeMicrosecond etim - return $ diff <= Microseconds (fromIntegral life * 1000000) - && dCID == l - && sCID == r -#if !defined(mingw32_HOST_OS) - -- Initial for ACK contains the retry token but - -- the version would be already version 2, sigh. - && _tver == peerVer -#endif - isRetryTokenValid _ = return False - sendRetry = do - newdCID <- newCID - retryToken <- generateRetryToken peerVer scTicketLifetime newdCID sCID dCID - mnewtoken <- timeout (Microseconds 100000) "sendRetry" $ encryptToken tokenMgr retryToken - case mnewtoken of - Nothing -> logAction "retry token stacked" - Just newtoken -> do - bss <- encodeRetryPacket $ RetryPacket peerVer sCID newdCID newtoken (Left dCID) - send' bss ----------------------------------------------------------------- -dispatch Dispatch{..} _ _ - _ _peersa _ _ tim - (cpkt@(CryptPacket (RTT0 _ o _) _), lvl, siz) = do - mq <- lookupRecvQDict srcTable o - case mq of - Just q -> writeRecvQ q $ mkReceivedPacket cpkt tim siz lvl - Nothing -> return () -#if defined(mingw32_HOST_OS) +dispatch + :: Dispatch + -> ServerConfig + -> DebugLogger + -> Socket + -> SockAddr + -> (ByteString -> IO ()) + -> Int + -> TimeMicrosecond + -> (CryptPacket, EncryptionLevel, Int) + -> IO () +dispatch + Dispatch{..} + ServerConfig{..} + logAction + mysock + peersa + send' + bytes + tim + (cpkt@(CryptPacket (Initial peerVer dCID sCID token) _), lvl, siz) + | bytes < defaultQUICPacketSize = do + logAction $ "too small " <> bhow bytes <> ", " <> bhow peersa + | peerVer `notElem` myVersions = do + let offerVersions + | peerVer == GreasingVersion = GreasingVersion2 : myVersions + | otherwise = GreasingVersion : myVersions + bss <- + encodeVersionNegotiationPacket $ + VersionNegotiationPacket sCID dCID offerVersions + send' bss + | token == "" = do + mconn <- lookupConnectionDict dstTable dCID + case mconn of + Nothing + | scRequireRetry -> sendRetry + | otherwise -> pushToAcceptFirst False + Just conn -> writeRecvQ (connRecvQ conn) $ mkReceivedPacket cpkt tim siz lvl + | otherwise = do + mconn <- lookupConnectionDict dstTable dCID + case mconn of + Nothing -> do + mct <- decryptToken tokenMgr token + case mct of + Just ct + | isRetryToken ct -> do + ok <- isRetryTokenValid ct + if ok then pushToAcceptRetried ct else sendRetry + _ -> pushToAcceptFirst True + Just conn -> writeRecvQ (connRecvQ conn) $ mkReceivedPacket cpkt tim siz lvl + where + myVersions = scVersions + pushToAcceptQ myAuthCIDs peerAuthCIDs key addrValid = do + mq <- lookupRecvQDict srcTable key + case mq of + Just q -> writeRecvQ q $ mkReceivedPacket cpkt tim siz lvl + Nothing -> do + q <- newRecvQ + insertRecvQDict srcTable key q + writeRecvQ q $ mkReceivedPacket cpkt tim siz lvl + let reg = registerConnectionDict dstTable + unreg = unregisterConnectionDict dstTable + ent = + Accept + { accVersionInfo = VersionInfo peerVer myVersions + , accMyAuthCIDs = myAuthCIDs + , accPeerAuthCIDs = peerAuthCIDs + , accMySocket = mysock + , accPeerSockAddr = peersa + , accRecvQ = q + , accPacketSize = bytes + , accRegister = reg + , accUnregister = unreg + , accAddressValidated = addrValid + , accTime = tim + } + -- fixme: check acceptQ length + writeAcceptQ acceptQ ent + -- Initial: DCID=S1, SCID=C1 -> + -- <- Initial: DCID=C1, SCID=S2 + -- ... + -- 1-RTT: DCID=S2 -> + -- <- 1-RTT: DCID=C1 + -- + -- initial_source_connection_id = S2 (newdCID) + -- original_destination_connection_id = S1 (dCID) + -- retry_source_connection_id = Nothing + pushToAcceptFirst addrValid = do + newdCID <- newCID + let myAuthCIDs = + defaultAuthCIDs + { initSrcCID = Just newdCID + , origDstCID = Just dCID + } + peerAuthCIDs = + defaultAuthCIDs + { initSrcCID = Just sCID + } + pushToAcceptQ myAuthCIDs peerAuthCIDs dCID addrValid + -- Initial: DCID=S1, SCID=C1 -> + -- <- Retry: DCID=C1, SCID=S2 + -- Initial: DCID=S2, SCID=C1 -> + -- <- Initial: DCID=C1, SCID=S3 + -- ... + -- 1-RTT: DCID=S3 -> + -- <- 1-RTT: DCID=C1 + -- + -- initial_source_connection_id = S3 (dCID) S2 in our server + -- original_destination_connection_id = S1 (o) + -- retry_source_connection_id = S2 (dCID) + pushToAcceptRetried (CryptoToken _ _ _ (Just (_, _, o))) = do + let myAuthCIDs = + defaultAuthCIDs + { initSrcCID = Just dCID + , origDstCID = Just o + , retrySrcCID = Just dCID + } + peerAuthCIDs = + defaultAuthCIDs + { initSrcCID = Just sCID + } + pushToAcceptQ myAuthCIDs peerAuthCIDs o True + pushToAcceptRetried _ = return () + isRetryTokenValid (CryptoToken _tver life etim (Just (l, r, _))) = do + diff <- getElapsedTimeMicrosecond etim + return $ + diff <= Microseconds (fromIntegral life * 1000000) + && dCID == l + && sCID == r + -- Initial for ACK contains the retry token but + -- the version would be already version 2, sigh. + && _tver == peerVer + isRetryTokenValid _ = return False + sendRetry = do + newdCID <- newCID + retryToken <- generateRetryToken peerVer scTicketLifetime newdCID sCID dCID + mnewtoken <- + timeout (Microseconds 100000) "sendRetry" $ encryptToken tokenMgr retryToken + case mnewtoken of + Nothing -> logAction "retry token stacked" + Just newtoken -> do + bss <- encodeRetryPacket $ RetryPacket peerVer sCID newdCID newtoken (Left dCID) + send' bss ---------------------------------------------------------------- -dispatch Dispatch{..} _ logAction - _mysock peersa _ _ tim - (cpkt@(CryptPacket hdr _crypt),lvl,siz) = do - let dCID = headerMyCID hdr - mconn <- lookupConnectionDict dstTable dCID - case mconn of - Nothing -> logAction $ "CID no match: " <> bhow dCID <> ", " <> bhow peersa - Just conn -> writeRecvQ (connRecvQ conn) $ mkReceivedPacket cpkt tim siz lvl -#else +dispatch + Dispatch{..} + _ + _ + _mysock + _peersa + _ + _ + tim + (cpkt@(CryptPacket (RTT0 _ dCID _) _), lvl, siz) = do + mq <- lookupRecvQDict srcTable dCID + case mq of + Just q -> writeRecvQ q $ mkReceivedPacket cpkt tim siz lvl + Nothing -> return () ---------------------------------------------------------------- -dispatch Dispatch{..} _ logAction - mysock peersa _ _ tim - ((CryptPacket hdr@(Short dCID) crypt),lvl,siz)= do - -- fixme: packets for closed connections also match here. - mconn <- lookupConnectionDict dstTable dCID - case mconn of - Nothing -> do - logAction $ "CID no match: " <> bhow dCID <> ", " <> bhow peersa - Just conn -> do - alive <- getAlive conn - when alive $ do - let miginfo = MigrationInfo mysock peersa dCID - crypt' = crypt { cryptMigraionInfo = Just miginfo } - cpkt = CryptPacket hdr crypt' +dispatch + Dispatch{..} + _ + logAction + mysock + peersa + _ + _ + tim + (cpkt@(CryptPacket hdr _crypt), lvl, siz) = do + let dCID = headerMyCID hdr + mconn <- lookupConnectionDict dstTable dCID + case mconn of + Nothing -> logAction $ "CID no match: " <> bhow dCID <> ", " <> bhow peersa + Just conn -> do + void $ setSocket conn mysock + setPeerSockAddr conn peersa writeRecvQ (connRecvQ conn) $ mkReceivedPacket cpkt tim siz lvl ----------------------------------------------------------------- -dispatch _ _ _ _ _ _ _ _ _ = return () -#endif ----------------------------------------------------------------- - --- | readerServer dies when the socket is closed. -readerServer :: UDPSocket -> Connection -> IO () -readerServer us conn = handleLogUnit logAction loop - where - loop = do - ito <- readMinIdleTimeout conn - mbs <- timeout ito "readerServer" $ UDP.recv us - case mbs of - Nothing -> UDP.close us - Just bs -> do - now <- getTimeMicrosecond - let quicBit = greaseQuicBit $ getMyParameters conn - pkts <- decodeCryptPackets bs (not quicBit) - mapM_ (\(p,l,siz) -> writeRecvQ (connRecvQ conn) (mkReceivedPacket p now siz l)) pkts - loop - logAction msg = connDebugLog conn ("debug: readerServer: " <> msg) - recvServer :: RecvQ -> IO ReceivedPacket recvServer = readRecvQ - ----------------------------------------------------------------- - -runNewServerReader :: Connection -> MigrationInfo -> IO () -runNewServerReader conn (MigrationInfo mysock peersa dCID) = handleLogUnit logAction $ do - migrating <- isPathValidating conn -- fixme: test and set - unless migrating $ do - setMigrationStarted conn - -- fixme: should not block - mcidinfo <- timeout (Microseconds 100000) "runNewServerReader" $ waitPeerCID conn - let msg = "Migration: " <> bhow peersa <> " (" <> bhow dCID <> ")" - qlogDebug conn $ Debug $ toLogStr msg - connDebugLog conn $ "debug: runNewServerReader: " <> msg - E.bracketOnError setup UDP.close $ \s1 -> - E.bracket (setSocket conn s1) UDP.close $ \_ -> do - void $ forkIO $ readerServer s1 conn - -- fixme: if cannot set - setMyCID conn dCID - validatePath conn mcidinfo - -- holding the old socket for a while - delay $ Microseconds 20000 - where - setup = UDP.accept mysock peersa - logAction msg = connDebugLog conn ("debug: runNewServerReader: " <> msg) diff --git a/Network/QUIC/Server/Run.hs b/Network/QUIC/Server/Run.hs --- a/Network/QUIC/Server/Run.hs +++ b/Network/QUIC/Server/Run.hs @@ -1,17 +1,14 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Network.QUIC.Server.Run ( - run - , runWithSockets - , stop - ) where + run, + runWithSockets, + stop, +) where import qualified Network.Socket as NS -import Network.UDP (UDPSocket(..), ListenSocket(..)) -import qualified Network.UDP as UDP import System.Log.FastLogger import UnliftIO.Async import UnliftIO.Concurrent @@ -34,6 +31,7 @@ import Network.QUIC.Recovery import Network.QUIC.Sender import Network.QUIC.Server.Reader +import Network.QUIC.Socket import Network.QUIC.Types ---------------------------------------------------------------- @@ -44,25 +42,26 @@ run :: ServerConfig -> (Connection -> IO ()) -> IO () run conf server = NS.withSocketsDo $ handleLogUnit debugLog $ do baseThreadId <- myThreadId - E.bracket setup teardown $ \(dispatch,_,_) -> do + E.bracket setup teardown $ \(dispatch, _, _) -> do onServerReady $ scHooks conf forever $ do acc <- accept dispatch void $ forkIO (runServer conf server dispatch baseThreadId acc) where doDebug = isJust $ scDebugLog conf - debugLog msg | doDebug = stdoutLogger ("run: " <> msg) - | otherwise = return () + debugLog msg + | doDebug = stdoutLogger ("run: " <> msg) + | otherwise = return () setup = do dispatch <- newDispatch conf -- fixme: the case where sockets cannot be created. - ssas <- mapM UDP.serverSocket $ scAddresses conf + ssas <- mapM serverSocket $ scAddresses conf tids <- mapM (runDispatcher dispatch conf) ssas return (dispatch, tids, ssas) teardown (dispatch, tids, ssas) = do clearDispatch dispatch mapM_ killThread tids - mapM_ UDP.stop ssas + mapM_ NS.close ssas -- | Running a QUIC server. -- The action is executed with a new connection @@ -70,59 +69,59 @@ runWithSockets :: [NS.Socket] -> ServerConfig -> (Connection -> IO ()) -> IO () runWithSockets ssas conf server = NS.withSocketsDo $ handleLogUnit debugLog $ do baseThreadId <- myThreadId - E.bracket setup teardown $ \(dispatch,_) -> do + E.bracket setup teardown $ \(dispatch, _) -> do onServerReady $ scHooks conf forever $ do acc <- accept dispatch void $ forkIO (runServer conf server dispatch baseThreadId acc) where doDebug = isJust $ scDebugLog conf - debugLog msg | doDebug = stdoutLogger ("run: " <> msg) - | otherwise = return () + debugLog msg + | doDebug = stdoutLogger ("run: " <> msg) + | otherwise = return () setup = do dispatch <- newDispatch conf -- fixme: the case where sockets cannot be created. - ssas' <- mapM mkSocket ssas - tids <- mapM (runDispatcher dispatch conf) ssas' + tids <- mapM (runDispatcher dispatch conf) ssas return (dispatch, tids) - mkSocket s = do - sa <- NS.getSocketName s - return $ ListenSocket s sa False -- interface specific teardown (dispatch, tids) = do clearDispatch dispatch mapM_ killThread tids -- Typically, ConnectionIsClosed breaks acceptStream. -- And the exception should be ignored. -runServer :: ServerConfig -> (Connection -> IO ()) -> Dispatch -> ThreadId -> Accept -> IO () +runServer + :: ServerConfig -> (Connection -> IO ()) -> Dispatch -> ThreadId -> Accept -> IO () runServer conf server0 dispatch baseThreadId acc = E.bracket open clse $ \(ConnRes conn myAuthCIDs _reader) -> handleLogUnit (debugLog conn) $ do -#if !defined(mingw32_HOST_OS) - forkIO _reader >>= addReader conn -#endif - let conf' = conf { - scParameters = (scParameters conf) { - versionInformation = Just $ accVersionInfo acc + let conf' = + conf + { scParameters = + (scParameters conf) + { versionInformation = Just $ accVersionInfo acc + } } - } handshaker <- handshakeServer conf' conn myAuthCIDs let server = do wait1RTTReady conn afterHandshakeServer conf conn server0 conn ldcc = connLDCC conn - supporters = foldr1 concurrently_ [handshaker - ,sender conn - ,receiver conn - ,resender ldcc - ,ldccTimer ldcc - ] + supporters = + foldr1 + concurrently_ + [ handshaker + , sender conn + , receiver conn + , resender ldcc + , ldccTimer ldcc + ] runThreads = do er <- race supporters server case er of - Left () -> E.throwIO MustNotReached - Right r -> return r + Left () -> E.throwIO MustNotReached + Right r -> return r ex <- E.trySyncOrAsync runThreads sendFinal conn closure conn ldcc ex @@ -132,36 +131,52 @@ let conn = connResConnection connRes setDead conn freeResources conn -#if !defined(mingw32_HOST_OS) - killReaders conn -#endif debugLog conn msg = do connDebugLog conn ("runServer: " <> msg) qlogDebug conn $ Debug $ toLogStr msg -createServerConnection :: ServerConfig -> Dispatch -> Accept -> ThreadId - -> IO ConnRes +createServerConnection + :: ServerConfig + -> Dispatch + -> Accept + -> ThreadId + -> IO ConnRes createServerConnection conf@ServerConfig{..} dispatch Accept{..} baseThreadId = do - us <- UDP.accept accMySocket accPeerSockAddr - let ListenSocket _ mysa _ = accMySocket - sref <- newIORef us + sref <- newIORef accMySocket + psaref <- newIORef accPeerSockAddr let send buf siz = void $ do - UDPSocket{..} <- readIORef sref - NS.sendBuf udpSocket buf siz + sock <- readIORef sref + sa <- readIORef psaref + NS.sendBufTo sock buf siz sa recv = recvServer accRecvQ let myCID = fromJust $ initSrcCID accMyAuthCIDs - ocid = fromJust $ origDstCID accMyAuthCIDs - (qLog, qclean) <- dirQLogger scQLog accTime ocid "server" + ocid = fromJust $ origDstCID accMyAuthCIDs + (qLog, qclean) <- dirQLogger scQLog accTime ocid "server" (debugLog, dclean) <- dirDebugLogger scDebugLog ocid debugLog $ "Original CID: " <> bhow ocid - conn <- serverConnection conf accVersionInfo accMyAuthCIDs accPeerAuthCIDs debugLog qLog scHooks sref accRecvQ send recv + conn <- + serverConnection + conf + accVersionInfo + accMyAuthCIDs + accPeerAuthCIDs + debugLog + qLog + scHooks + sref + psaref + accRecvQ + send + recv addResource conn qclean addResource conn dclean let cid = fromMaybe ocid $ retrySrcCID accMyAuthCIDs ver = chosenVersion accVersionInfo initializeCoder conn InitialLevel $ initialSecrets ver cid setupCryptoStreams conn -- fixme: cleanup - let pktSiz = (defaultPacketSize mysa `max` accPacketSize) `min` maximumPacketSize mysa + let pktSiz = + (defaultPacketSize accPeerSockAddr `max` accPacketSize) + `min` maximumPacketSize accPeerSockAddr setMaxPacketSize conn pktSiz setInitialCongestionWindow (connLDCC conn) pktSiz debugLog $ "Packet size: " <> bhow pktSiz <> " (" <> bhow accPacketSize <> ")" @@ -182,13 +197,9 @@ addResource conn $ do myCIDs <- getMyCIDs conn mapM_ accUnregister myCIDs + -- -#if defined(mingw32_HOST_OS) return $ ConnRes conn accMyAuthCIDs undefined -#else - let reader = readerServer us conn -- dies when us is closed. - return $ ConnRes conn accMyAuthCIDs reader -#endif afterHandshakeServer :: ServerConfig -> Connection -> IO () afterHandshakeServer ServerConfig{..} conn = handleLogT logAction $ do @@ -202,7 +213,7 @@ mgr <- getTokenManager conn token <- encryptToken mgr cryptoToken let ncid = NewConnectionID cidInfo 0 - sendFrames conn RTT1Level [NewToken token,ncid,HandshakeDone] + sendFrames conn RTT1Level [NewToken token, ncid, HandshakeDone] where logAction msg = connDebugLog conn $ "afterHandshakeServer: " <> msg diff --git a/Network/QUIC/Socket.hs b/Network/QUIC/Socket.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Socket.hs @@ -0,0 +1,38 @@ +module Network.QUIC.Socket ( + serverSocket, + clientSocket, + natRebinding, +) where + +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 + where + family = sockAddrFamily sa + open = socket family Datagram defaultProtocol + +sockAddrFamily :: SockAddr -> Family +sockAddrFamily SockAddrInet{} = AF_INET +sockAddrFamily SockAddrInet6{} = AF_INET6 +sockAddrFamily _ = error "sockAddrFamily" + +clientSocket :: HostName -> ServiceName -> IO (Socket, SockAddr) +clientSocket host port = do + addr <- head <$> getAddrInfo (Just hints) (Just host) (Just port) + E.bracketOnError (openSocket addr) close $ \s -> return (s, addrAddress addr) + where + hints = defaultHints{addrSocketType = Datagram, addrFlags = [AI_ADDRCONFIG]} + +serverSocket :: (IP, PortNumber) -> IO Socket +serverSocket ip = E.bracketOnError open close $ \s -> do + setSocketOption s ReuseAddr 1 + withFdSocket s setCloseOnExecIfNeeded + bind s sa + return s + where + sa = toSockAddr ip + family = sockAddrFamily sa + open = socket family Datagram defaultProtocol diff --git a/Network/QUIC/Types/Packet.hs b/Network/QUIC/Types/Packet.hs --- a/Network/QUIC/Types/Packet.hs +++ b/Network/QUIC/Types/Packet.hs @@ -8,7 +8,6 @@ import Data.Ix import GHC.Generics import Network.TLS.QUIC (ExtensionID (EID_QuicTransportParameters, ExtensionID)) -import Network.UDP import Text.Printf import Network.QUIC.Imports @@ -159,14 +158,10 @@ is4bytesPN :: Int -> Bool is4bytesPN = (`testBit` 9) -data MigrationInfo = MigrationInfo ListenSocket ClientSockAddr CID - deriving (Eq, Show) - data Crypt = Crypt { cryptPktNumOffset :: Int , cryptPacket :: ByteString , cryptMarks :: Int - , cryptMigraionInfo :: Maybe MigrationInfo } deriving (Eq, Show) diff --git a/Network/QUIC/Windows.hs b/Network/QUIC/Windows.hs --- a/Network/QUIC/Windows.hs +++ b/Network/QUIC/Windows.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE CPP #-} + module Network.QUIC.Windows ( windowsThreadBlockHack, ) where +#if defined(mingw32_HOST_OS) import Control.Concurrent import qualified Control.Exception as CE import Control.Monad @@ -15,3 +18,7 @@ case res of Left e -> print e >> CE.throwIO e Right r -> return r +#else +windowsThreadBlockHack :: IO a -> IO a +windowsThreadBlockHack = id +#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.28 +version: 0.2.0 license: BSD3 license-file: LICENSE maintainer: kazu@iij.ad.jp @@ -97,6 +97,7 @@ Network.QUIC.Sender Network.QUIC.Server.Reader Network.QUIC.Server.Run + Network.QUIC.Socket Network.QUIC.Stream Network.QUIC.Stream.Frag Network.QUIC.Stream.Misc @@ -145,7 +146,6 @@ network >= 3.1.4, network-byte-order >= 0.1.7 && < 0.2, network-control >= 0.1 && < 0.2, - network-udp >= 0.0.0 && < 0.1, random >= 1.2.1 && < 1.3, serialise, tls >= 2.0 && < 2.2, @@ -255,7 +255,6 @@ crypton, hspec, network >=3.1.2, - network-udp, quic, tls, unix-time, diff --git a/test/PacketSpec.hs b/test/PacketSpec.hs --- a/test/PacketSpec.hs +++ b/test/PacketSpec.hs @@ -7,7 +7,6 @@ import qualified Data.ByteString.Internal as BS import Data.IORef import Data.Tuple (swap) -import Network.UDP import Test.Hspec import Network.QUIC.Internal @@ -47,9 +46,10 @@ clientAuthCIDs = defaultAuthCIDs{initSrcCID = Just clientCID} -- dummy let clientConf = testClientConfig - us <- clientSocket "127.0.0.1" "2000" False + (sock, peersa) <- clientSocket "127.0.0.1" "2000" q <- newRecvQ - sref <- newIORef us + sref <- newIORef sock + psaref <- newIORef peersa let ver = v verInfo = VersionInfo ver [ver] ---- @@ -63,6 +63,7 @@ noLog defaultHooks sref + psaref q undefined undefined @@ -77,6 +78,7 @@ noLog defaultHooks sref + psaref -- dummy q undefined undefined diff --git a/util/quic-client.hs b/util/quic-client.hs --- a/util/quic-client.hs +++ b/util/quic-client.hs @@ -44,7 +44,6 @@ , optPacketSize :: Maybe Int , optPerformance :: Word64 , optNumOfReqs :: Int - , optUnconSock :: Bool } deriving (Show) @@ -68,7 +67,6 @@ , optPacketSize = Nothing , optPerformance = 0 , optNumOfReqs = 1 - , optUnconSock = True } usage :: String @@ -176,11 +174,6 @@ ["number-of-requests"] (ReqArg (\n o -> o{optNumOfReqs = read n}) "") "specify the number of requests" - , Option - ['m'] - ["use-connected-socket"] - (NoArg (\o -> o{optUnconSock = False})) - "use connected sockets instead of unconnected sockets" ] showUsageAndExit :: String -> IO a @@ -239,7 +232,6 @@ defaultHooks { onCloseCompleted = putMVar cmvar () } - , ccAutoMigration = optUnconSock } debug | optDebugLog = putStrLn @@ -398,11 +390,11 @@ } printThroughput :: UnixTime -> UnixTime -> ConnectionStats -> IO () -printThroughput t1 t2 ConnectionStats{..} = +printThroughput t1 t2 stats = printf "Throughput %.2f Mbps (%d bytes in %d msecs)\n" bytesPerSeconds - rxBytes + (rxBytes stats) millisecs where UnixDiffTime (CTime s) u = t2 `diffUnixTime` t1 @@ -410,7 +402,7 @@ millisecs = fromIntegral s * 1000 + fromIntegral u `div` 1000 bytesPerSeconds :: Double bytesPerSeconds = - fromIntegral rxBytes + fromIntegral (rxBytes stats) * (1000 :: Double) * 8 / fromIntegral millisecs