LaurentRDC · Oct 6, 2026 · Oct 2, 2026
diff --git a/packages/network-transport-quic/CHANGELOG.md b/packages/network-transport-quic/CHANGELOG.md
@@ -1,3 +1,11 @@
+Unreleased   Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.2.0
+
+* All the logical connections between two endpoints are now carried by a single QUIC connection (one stream
+  each), rather than by one QUIC connection for each endpoint pairs. This has large performance implications:
+  for multiple logical connections between two endpoints, `network-transport-quic` throughput increases by 50% over
+  version 0.1.x, for a total of 3x throughput over `network-transport-quic`.
+* Breaking change: A new `socketOptions` field to `QUICTransportConfig`, allowing the user to control the UDP socket
+  underlying a connection.
 
 2026-04-21  Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.1.2
 

diff --git a/packages/network-transport-quic/README.md b/packages/network-transport-quic/README.md
@@ -8,7 +8,7 @@ QUIC has many advantages over TCP, including:
 * Connection migration. Connections survive IP address changes, which is important when a device switches from e.g. WIFI to 5G;
 * Built-in encryption via TLS 1.3;
 
-In benchmarks, `network-transport-quic` performs better than `network-transport-tcp` in dense network topologies. For example, if every `EndPoint` in your network connects to every other `EndPoint`, you might benefit greatly from switching to `network-transport-quic`! 
+In benchmarks, `network-transport-quic` performs better than `network-transport-tcp` in dense network topologies. For multiple logical connections between two endpoints, `network-transport-quic` can be 3x faster (in throughput) compared to `network-transport-tcp`.
 
 ## Usage example
 

diff --git a/packages/network-transport-quic/bench/Bench.hs b/packages/network-transport-quic/bench/Bench.hs
@@ -6,50 +6,51 @@
 
 module Main where
 
-import Control.Concurrent (forkIO)
-import Control.Concurrent.Async (forConcurrently_)
+import Control.Concurrent.Async (forConcurrently_, link, wait, withAsync)
 import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
 import Control.Exception (finally, throwIO)
-import Control.Monad (forM_, replicateM, void, when)
+import Control.Monad (forM_, forever, replicateM, void, when)
 import qualified Data.ByteString as BS
-import Data.IORef (
-  atomicModifyIORef',
-  newIORef,
- )
+import Data.IORef
+  ( atomicModifyIORef',
+    newIORef,
+  )
 import Data.List.NonEmpty (NonEmpty (..))
-import Network.Transport (
-  Connection (send),
-  EndPoint (address, connect, receive),
-  Event (ConnectionOpened, Received),
-  Reliability (ReliableOrdered),
-  Transport (closeTransport, newEndPoint),
-  defaultConnectHints,
- )
+import qualified Network.Socket as N
+import Network.Transport
+  ( Connection (send),
+    EndPoint (address, connect, receive),
+    Event (ConnectionOpened, ErrorEvent, Received),
+    Reliability (ReliableOrdered),
+    Transport (closeTransport, newEndPoint),
+    defaultConnectHints,
+  )
 import qualified Network.Transport.QUIC as QUIC
 import qualified Network.Transport.TCP as TCP
 import System.FilePath ((</>))
-import Test.Tasty (TestTree)
-import Test.Tasty.Bench (bench, bgroup, defaultMain, nfIO)
+import System.Timeout (timeout)
+import Test.Tasty (localOption)
+import Test.Tasty.Bench (Benchmark, TimeMode (WallTime), bench, bgroup, defaultMain, nfIO)
 
 data TransportConfig = TransportConfig
-  { transportName :: String
-  , mkTransport :: IO Transport
+  { transportName :: String,
+    mkTransport :: IO Transport
   }
 
 tcpConfig :: TransportConfig
 tcpConfig =
   TransportConfig
-    { transportName = "TCP"
-    , mkTransport = do
+    { transportName = "TCP",
+      mkTransport = do
         Right t <- TCP.createTransport (TCP.defaultTCPAddr "127.0.0.1" "0") TCP.defaultTCPParameters
         pure t
     }
 
 quicConfig :: TransportConfig
 quicConfig =
   TransportConfig
-    { transportName = "QUIC"
-    , mkTransport =
+    { transportName = "QUIC",
+      mkTransport =
         QUIC.credentialLoadX509
           -- Generate a self-signed x509v3 certificate using this nifty tool:
           -- https://certificatetools.com/
@@ -59,103 +60,125 @@ quicConfig =
             Left errmsg -> throwIO $ userError errmsg
             Right credentials ->
               QUIC.createTransport
-                ( QUIC.QUICTransportConfig
-                    { hostName = "127.0.0.1"
-                    , serviceName = "0"
-                    , credentials = credentials :| []
-                    , -- credentials are self-signed
-                      validateCredentials = False
+                ( (QUIC.defaultQUICTransportConfig "127.0.0.1" (credentials :| []))
+                    { QUIC.serviceName = "0",
+                      QUIC.validateCredentials = False,
+                      -- For benchmarks with lots of streams and tiny messages, we can easily
+                      -- overflow the receive buffer
+                      QUIC.socketOptions = [(N.RecvBuffer, 4 * 1024 * 1024)]
                     }
                 )
     }
 
 data BenchParams = BenchParams
-  { messageSize :: !Int
-  , messageCount :: !Int
-  , connectionCount :: !Int
+  { messageSize :: !Int,
+    messageCount :: !Int,
+    connectionCount :: !Int
   }
 
 smallMessages, mediumMessages, largeMessages :: BenchParams
-smallMessages = BenchParams{messageSize = 64, messageCount = 10_000, connectionCount = 1}
-mediumMessages = BenchParams{messageSize = 1024, messageCount = 1_000, connectionCount = 1}
-largeMessages = BenchParams{messageSize = 4096, messageCount = 100, connectionCount = 1}
+smallMessages = BenchParams {messageSize = 64, messageCount = 10_000, connectionCount = 1}
+mediumMessages = BenchParams {messageSize = 1024, messageCount = 1_000, connectionCount = 1}
+largeMessages = BenchParams {messageSize = 4096, messageCount = 100, connectionCount = 1}
 
 multiConn :: Int -> BenchParams -> BenchParams
-multiConn n p = p{connectionCount = n}
+multiConn n p = p {connectionCount = n}
 
 throughputBench :: TransportConfig -> BenchParams -> IO ()
-throughputBench TransportConfig{mkTransport} BenchParams{messageSize, messageCount, connectionCount} = do
+throughputBench cfg params =
+  timeout 30_000_000 (throughputBench' cfg params)
+    >>= maybe (throwIO $ userError "benchmark stalled: timed out waiting for messages") pure
+
+throughputBench' :: TransportConfig -> BenchParams -> IO ()
+throughputBench' TransportConfig {mkTransport} BenchParams {messageSize, messageCount, connectionCount} = do
   transport <- mkTransport
-  flip finally (closeTransport transport) $ do
+  -- Closing is bounded as well: it can block if a connection was lost, and that
+  -- would hide the failure we are trying to report.
+  flip finally (void $ timeout 5_000_000 (closeTransport transport)) $ do
     Right senderEP <- newEndPoint transport
     Right receiverEP <- newEndPoint transport
 
     let payload = BS.replicate messageSize 0x42
         totalMessages = messageCount * connectionCount
 
     receiverReady <- newEmptyMVar
-    receiverDone <- newEmptyMVar
-
-    void $ forkIO $ do
-      connsEstablished <- newIORef (0 :: Int)
-      let waitForConnections = do
-            event <- receive receiverEP
-            case event of
-              ConnectionOpened{} -> do
-                n <- atomicModifyIORef' connsEstablished (\x -> (x + 1, x + 1))
-                when (n < connectionCount) waitForConnections
-              _ -> waitForConnections
-      waitForConnections
-      putMVar receiverReady ()
-
-      msgsReceived <- newIORef (0 :: Int)
-      let recvLoop = do
-            event <- receive receiverEP
-            case event of
-              Received _ _ -> do
-                n <- atomicModifyIORef' msgsReceived (\x -> (x + 1, x + 1))
-                when (n < totalMessages) recvLoop
-              _ -> recvLoop
-      recvLoop
-      putMVar receiverDone ()
-
-    let receiverAddr = address receiverEP
-    connections <-
-      replicateM
-        connectionCount
-        (connect senderEP receiverAddr ReliableOrdered defaultConnectHints >>= either throwIO pure)
-
-    takeMVar receiverReady
-
-    forConcurrently_ connections $ \conn ->
-      forM_ [0 .. messageCount] $ \_ -> send conn [payload]
-
-    takeMVar receiverDone
-
-benchTransport :: TransportConfig -> TestTree
-benchTransport cfg@TransportConfig{transportName} =
+
+    let receiver = do
+          connsEstablished <- newIORef (0 :: Int)
+          let waitForConnections = do
+                event <- receive receiverEP
+                case event of
+                  ConnectionOpened {} -> do
+                    n <- atomicModifyIORef' connsEstablished (\x -> (x + 1, x + 1))
+                    when (n < connectionCount) waitForConnections
+                  ErrorEvent err -> throwIO err
+                  _ -> waitForConnections
+          waitForConnections
+          putMVar receiverReady ()
+
+          msgsReceived <- newIORef (0 :: Int)
+          let recvLoop = do
+                event <- receive receiverEP
+                case event of
+                  Received _ _ -> do
+                    n <- atomicModifyIORef' msgsReceived (\x -> (x + 1, x + 1))
+                    when (n < totalMessages) recvLoop
+                  ErrorEvent err -> throwIO err
+                  _ -> recvLoop
+          recvLoop
+
+    let watchSender = forever $ do
+          event <- receive senderEP
+          case event of
+            ErrorEvent err -> throwIO err
+            _ -> pure ()
+
+    withAsync receiver $ \receiverAsync -> withAsync watchSender $ \senderAsync -> do
+      link receiverAsync
+      link senderAsync
+
+      let receiverAddr = address receiverEP
+      connections <-
+        replicateM
+          connectionCount
+          (connect senderEP receiverAddr ReliableOrdered defaultConnectHints >>= either throwIO pure)
+
+      takeMVar receiverReady
+
+      forConcurrently_ connections $ \conn ->
+        forM_ [0 .. messageCount] $ \_ -> send conn [payload] >>= either throwIO pure
+
+      wait receiverAsync
+
+benchTransport :: TransportConfig -> Benchmark
+benchTransport cfg@TransportConfig {transportName} =
   bgroup
     transportName
     [ bgroup
         "throughput"
         [ bgroup
             "single-connection"
-            [ bench "small-msg" $ nfIO $ throughputBench cfg smallMessages
-            , bench "default-msg" $ nfIO $ throughputBench cfg mediumMessages
-            , bench "large-msg" $ nfIO $ throughputBench cfg largeMessages
-            ]
-        , bgroup
+            [ bench "small-msg" $ nfIO $ throughputBench cfg smallMessages,
+              bench "default-msg" $ nfIO $ throughputBench cfg mediumMessages,
+              bench "large-msg" $ nfIO $ throughputBench cfg largeMessages
+            ],
+          bgroup
             "multi-connection"
-            [ bench "2-conn" $ nfIO $ throughputBench cfg smallMessages{connectionCount = 2, messageCount = 10_000}
-            , bench "5-conn" $ nfIO $ throughputBench cfg smallMessages{connectionCount = 5, messageCount = 10_000}
-            , bench "10-conn" $ nfIO $ throughputBench cfg smallMessages{connectionCount = 10, messageCount = 5_000}
+            [ bench "2-conn" $ nfIO $ throughputBench cfg smallMessages {connectionCount = 2, messageCount = 10_000},
+              bench "5-conn" $ nfIO $ throughputBench cfg smallMessages {connectionCount = 5, messageCount = 10_000},
+              bench "10-conn" $ nfIO $ throughputBench cfg smallMessages {connectionCount = 10, messageCount = 5_000},
+              bench "50-conn" $ nfIO $ throughputBench cfg smallMessages {connectionCount = 50, messageCount = 100},
+              bench "100-conn" $ nfIO $ throughputBench cfg smallMessages {connectionCount = 100, messageCount = 50}
             ]
         ]
     ]
 
 main :: IO ()
 main =
   defaultMain
-    [ benchTransport tcpConfig
-    , benchTransport quicConfig
+    -- QUIC is a userspace networking protocol,
+    -- so CPU time isn't the appropriate comparison
+    -- to make with TCP
+    [ localOption WallTime (benchTransport tcpConfig),
+      localOption WallTime (benchTransport quicConfig)
     ]
diff --git a/packages/network-transport-quic/network-transport-quic.cabal b/packages/network-transport-quic/network-transport-quic.cabal
@@ -1,6 +1,6 @@
 cabal-version: 3.0
 Name:          network-transport-quic
-Version:       0.1.2
+Version:       0.2.0
 build-Type:    Simple
 License:       BSD-3-Clause
 License-file:  LICENSE
@@ -59,10 +59,9 @@ library
                     , microlens-platform ^>=0.4
                     , network >= 3.1 && < 3.3
                     , network-transport >= 0.5 && < 0.6
-                    -- Prior to version 0.2.20, `quic` had issues with handling
-                    -- pending data in the stream buffer. This meant that vectored
-                    -- message sends did not work correctly at the transport layer
-                    , quic >=0.2.20 && <0.4
+                    -- Version 0.3.15 added graceful server shutdown which
+                    -- changes the way network-transport-quic works
+                    , quic >=0.3.15 && <0.4
                     , stm >=2.4 && <2.6
                     , tls >= 2.1 && < 2.5
                     , tls-session-manager >= 0.0.5 && <0.2
@@ -97,6 +96,7 @@ test-suite network-transport-quic-tests
                       , network-transport
                       , network-transport-quic
                       , network-transport-tests
+                      , quic
                       , tasty ^>=1.5
                       , tasty-flaky ^>= 0.1.3
                       , tasty-hedgehog
@@ -108,13 +108,15 @@ benchmark network-transport-quic-bench
     hs-source-dirs:   bench
     main-is:          Bench.hs
     default-language: Haskell2010
-    ghc-options:      -rtsopts -with-rtsopts=-N
+    -- -T makes the allocations of each benchmark appear in its results
+    ghc-options:      -rtsopts "-with-rtsopts=-N -T"
     build-depends:    async
                     , base              >=4.14 && <5
                     , bytestring
                     , filepath
+                    , network
                     , network-transport
                     , network-transport-tcp
                     , network-transport-quic
-                    , tasty ^>=1.5
+                    , tasty             ^>=1.5
                     , tasty-bench       >=0.4