labeling threads

kazu-yamamoto · Nov 1, 2024 · c5e9796 · c5e9796
1 parent 4ad3835
commit c5e9796
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 11 deletions.
diff --git a/Network/QUIC/Closer.hs b/Network/QUIC/Closer.hs
@@ -8,6 +8,7 @@ import Foreign.Marshal.Alloc
 import Foreign.Ptr
 import qualified Network.Socket as NS
 
+import Network.QUIC.Common
 import Network.QUIC.Config
 import Network.QUIC.Connection
 import Network.QUIC.Connector
@@ -101,7 +102,9 @@ encodeCC conn res0@(SizedBuffer sendbuf0 bufsiz0) frame = do
                 return 0
 
 closer :: Connection -> Microseconds -> IO () -> IO () -> IO () -> IO ()
-closer _conn (Microseconds pto) send recv hook = loop (3 :: Int)
+closer _conn (Microseconds pto) send recv hook = do
+    labelMe "QUIC closer"
+    loop (3 :: Int)
   where
     loop 0 = return ()
     loop n = do

diff --git a/Network/QUIC/Server/Run.hs b/Network/QUIC/Server/Run.hs
@@ -111,17 +111,18 @@ runServer conf server0 dispatch baseThreadId acc = do
                     afterHandshakeServer conf conn
                     server0 conn
                 ldcc = connLDCC conn
-                supporters =
-                    foldr1
-                        concurrently_
-                        [ handshaker
-                        , sender conn
-                        , receiver conn
-                        , resender ldcc
-                        , ldccTimer ldcc
-                        ]
+            let s1 = labelMe "handshaker" >> handshaker
+                s2 = labelMe "sender" >> sender conn
+                s3 = labelMe "receiver" >> receiver conn
+                s4 = labelMe "resender" >> resender ldcc
+                s5 = labelMe "ldccTimer" >> ldccTimer ldcc
+                c1 = labelMe "concurrently1" >> concurrently_ s1 s2
+                c2 = labelMe "concurrently2" >> concurrently_ c1 s3
+                c3 = labelMe "concurrently3" >> concurrently_ c2 s4
+                c4 = labelMe "concurrently4" >> concurrently_ c3 s5
+                supporters = c4
                 runThreads = do
-                    er <- race supporters server
+                    er <- race supporters (labelMe "QUIC server" >> server)
                     case er of
                         Left () -> E.throwIO MustNotReached
                         Right r -> return r