diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Erebos/Discovery.hs | 73 |
1 files changed, 39 insertions, 34 deletions
diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs index 4c9d89b..63f5cf1 100644 --- a/src/Erebos/Discovery.hs +++ b/src/Erebos/Discovery.hs @@ -307,46 +307,51 @@ instance Service DiscoveryService where discoveryPeer <- asks svcPeer let runAsService = runPeerService @DiscoveryService discoveryPeer - forM_ addrs $ \case - DiscoveryICE -> do -#ifdef ENABLE_ICE_SUPPORT - getIceConfig >>= \case - Just config -> void $ liftIO $ forkIO $ do - ice <- iceCreateSession config PjIceSessRoleControlling $ \ice -> do - rinfo <- iceRemoteInfo ice - - -- Try to promote weak ref to normal one for older peers: - edgst' <- case edgst of - Left r -> return (Left r) - Right d -> refFromDigest st d >>= \case - Just r -> return (Left r) - Nothing -> return (Right d) - - res <- runExceptT $ sendToPeer discoveryPeer $ - DiscoveryConnectionRequest (emptyConnection (Left $ storedRef $ idData self) edgst') { dconnIceInfo = Just rinfo } - case res of - Right _ -> return () - Left err -> putStrLn $ "Discovery: failed to send connection request: " ++ err - + let tryAddresses = \case + DiscoveryIP ipaddr port : _ -> do + void $ liftIO $ forkIO $ do + let saddr = inetToSockAddr ( ipaddr, port ) + peer <- serverPeer server saddr runAsService $ do - let upd dp = dp { dpIceSession = Just ice } + let upd dp = dp { dpPeer = Just peer } svcModifyGlobal $ \s -> s { dgsPeers = M.alter (Just . upd . fromMaybe emptyPeer) dgst $ dgsPeers s } - Nothing -> do - return () + DiscoveryICE : rest -> do +#ifdef ENABLE_ICE_SUPPORT + getIceConfig >>= \case + Just config -> do + void $ liftIO $ forkIO $ do + ice <- iceCreateSession config PjIceSessRoleControlling $ \ice -> do + rinfo <- iceRemoteInfo ice + + -- Try to promote weak ref to normal one for older peers: + edgst' <- case edgst of + Left r -> return (Left r) + Right d -> refFromDigest st d >>= \case + Just r -> return (Left r) + Nothing -> return (Right d) + + res <- runExceptT $ sendToPeer discoveryPeer $ + DiscoveryConnectionRequest (emptyConnection (Left $ storedRef $ idData self) edgst') { dconnIceInfo = Just rinfo } + case res of + Right _ -> return () + Left err -> putStrLn $ "Discovery: failed to send connection request: " ++ err + + runAsService $ do + let upd dp = dp { dpIceSession = Just ice } + svcModifyGlobal $ \s -> s { dgsPeers = M.alter (Just . upd . fromMaybe emptyPeer) dgst $ dgsPeers s } + + Nothing -> do #endif - return () + tryAddresses rest - DiscoveryIP ipaddr port -> do - void $ liftIO $ forkIO $ do - let saddr = inetToSockAddr ( ipaddr, port ) - peer <- serverPeer server saddr - runAsService $ do - let upd dp = dp { dpPeer = Just peer } - svcModifyGlobal $ \s -> s { dgsPeers = M.alter (Just . upd . fromMaybe emptyPeer) dgst $ dgsPeers s } + addr : rest -> do + svcPrint $ "Discovery: unsupported address in result: " ++ T.unpack (toText addr) + tryAddresses rest + + [] -> svcPrint $ "Discovery: no (supported) address received for " <> show dgst - addr -> do - svcPrint $ "Discovery: invalid address in result: " ++ T.unpack (toText addr) + tryAddresses addrs DiscoveryConnectionRequest conn -> do self <- svcSelf |