quic 0.1.28 → 0.2.0

raw patch · 21 files changed

+468/−440 lines, 21 filesdep −network-udpPVP ok

version bump matches the API change (PVP)

Dependencies removed: network-udp

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• Network/QUIC.hs +13/−2
• Network/QUIC/Client.hs +0/−1
• Network/QUIC/Client/Reader.hs +15/−13
• Network/QUIC/Client/Run.hs +10/−12
• Network/QUIC/Closer.hs +29/−28
• Network/QUIC/Config.hs +0/−3
• Network/QUIC/Connection/Misc.hs +16/−7
• Network/QUIC/Connection/Types.hs +12/−6
• Network/QUIC/Info.hs +5/−4
• Network/QUIC/Internal.hs +2/−0
• Network/QUIC/Packet/Decode.hs +2/−2
• Network/QUIC/Receiver.hs +0/−6
• Network/QUIC/Server/Reader.hs +235/−278
• Network/QUIC/Server/Run.hs +67/−56
• Network/QUIC/Socket.hs +38/−0
• Network/QUIC/Types/Packet.hs +0/−5
• Network/QUIC/Windows.hs +7/−0
• quic.cabal +2/−3
• test/PacketSpec.hs +5/−3
• util/quic-client.hs +3/−11

@@ -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.

@@ -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,

@@ -18,7 +18,6 @@     ccVersions,     --  , ccCredentials     ccValidate,-    ccAutoMigration,      -- * Resumption     ResumptionInfo,

@@ -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

@@ -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

@@ -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

@@ -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         }  ----------------------------------------------------------------

@@ -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  ---------------------------------------------------------------- 

@@ -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

@@ -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             }

@@ -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

@@ -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  ---------------------------------------------------------------- 

@@ -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

@@ -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)

@@ -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 

@@ -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

@@ -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) 

@@ -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

@@ -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,

@@ -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

@@ -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}) "<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