Dns subscription: Use withAsync instead of async

This kills the spawned threads if the main thread dies
IntersectMBO · Jan 27, 2021 · cacf8ac · cacf8ac
1 parent 364e9d9
commit cacf8ac
Showing 1 changed file with 11 additions and 11 deletions.
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Subscription/Dns.hs b/ouroboros-network-framework/src/Ouroboros/Network/Subscription/Dns.hs
@@ -122,17 +122,17 @@ dnsResolve tracer getSeed withResolverFn peerStatesVar beforeConnect (DnsSubscri
                  -- TODO: Fix upstream dns lib.
                  --       On windows the aid_ipv6 and aid_ipv4 threads are leaked incase
                  --       of an exception in the main thread.
-                 res <- timeout 20 $ do
-                          aid_ipv6 <- async $ resolveAAAA resolver
-                          aid_ipv4 <- async $ resolveA resolver aid_ipv6
-                          rd_e <- waitEitherCatch aid_ipv6 aid_ipv4
-                          case rd_e of
-                            Left r -> do
-                              traceWith tracer DnsTraceLookupIPv6First
-                              handleThreadResult r $ threadTargetCycle aid_ipv4
-                            Right r -> do
-                              traceWith tracer DnsTraceLookupIPv4First
-                              handleThreadResult r $ threadTargetCycle aid_ipv6
+                 res <- timeout 20 $
+                   withAsync (resolveAAAA resolver) $ \aid_ipv6 ->
+                     withAsync (resolveA resolver aid_ipv6) $ \aid_ipv4 -> do
+                       rd_e <- waitEitherCatch aid_ipv6 aid_ipv4
+                       case rd_e of
+                         Left r -> do
+                           traceWith tracer DnsTraceLookupIPv6First
+                           handleThreadResult r $ threadTargetCycle aid_ipv4
+                         Right r -> do
+                           traceWith tracer DnsTraceLookupIPv4First
+                           handleThreadResult r $ threadTargetCycle aid_ipv6
                  case res of
                    Nothing -> do
                      -- TODO: the thread timedout, we should trace it