diff options
Diffstat (limited to 'src/Erebos/Discovery.hs')
| -rw-r--r-- | src/Erebos/Discovery.hs | 16 |
1 files changed, 15 insertions, 1 deletions
diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs index 5788ab8..2c1d409 100644 --- a/src/Erebos/Discovery.hs +++ b/src/Erebos/Discovery.hs @@ -431,7 +431,14 @@ instance Service DiscoveryService where let addr = TunnelAddress {..} void $ serverPeerCustom server addr receiveFromTunnel server addr - [] -> svcPrint $ "Discovery: missing stream in tunnel response" + [] -> do + svcPrint $ "Discovery: missing stream in tunnel response" + liftIO $ closeStream tunnelWriter + + | Just tunnelWriter <- lookup (either refDigest id (dconnTarget conn)) (dpsOurTunnelRequests dps) + -> do + svcPrint $ "Discovery: tunnel request failed" + liftIO $ closeStream tunnelWriter #ifdef ENABLE_ICE_SUPPORT | Just dp <- M.lookup (either refDigest id $ dconnTarget conn) dpeers @@ -449,6 +456,7 @@ instance Service DiscoveryService where case M.lookup (either refDigest id $ dconnSource conn) dpeers of Just dp | Just dpeer <- dpPeer dp -> if + -- successful tunnel request | dconnTunnel conn , Just ( fromSource, toTarget ) <- lookup (either refDigest id (dconnSource conn)) (dpsRelayedTunnelRequests dps) , fromTarget : _ <- streams @@ -465,6 +473,12 @@ instance Service DiscoveryService where toSource <- readMVar toSourceVar relayStream fromTarget toSource + -- failed tunnel request + | Just ( _, toTarget ) <- lookup (either refDigest id (dconnSource conn)) (dpsRelayedTunnelRequests dps) + -> do + liftIO $ closeStream toTarget + sendToPeer dpeer $ DiscoveryConnectionResponse conn + | otherwise -> do sendToPeer dpeer $ DiscoveryConnectionResponse conn _ -> svcPrint $ "Discovery: failed to relay connection response" |