summaryrefslogtreecommitdiff
path: root/src/Erebos
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2025-07-28 19:16:18 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2025-07-29 09:33:16 +0200
commitd8160f03094e6d18509956efe9bb6aeda31d79c5 (patch)
treeef45877dcf6e64591ab08fec18356c1bc5738388 /src/Erebos
parent8bcaaf5524504f01bd5643d74848cec625370aa9 (diff)
Return peer address in IO monad
Changelog: API: Replaced `Network.peerAddress` with `getPeerAddress` and added `getPeerAddresses`
Diffstat (limited to 'src/Erebos')
-rw-r--r--src/Erebos/Discovery.hs17
-rw-r--r--src/Erebos/Network.hs10
2 files changed, 16 insertions, 11 deletions
diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs
index ff07964..a83e589 100644
--- a/src/Erebos/Discovery.hs
+++ b/src/Erebos/Discovery.hs
@@ -246,19 +246,16 @@ instance Service DiscoveryService where
DiscoverySelf addrs priority -> do
pid <- asks svcPeerIdentity
peer <- asks svcPeer
+ paddrs <- getPeerAddresses peer
+
let insertHelper new old | dpPriority new > dpPriority old = new
| otherwise = old
- matchedAddrs <- flip filterM addrs $ \case
- DiscoveryICE -> do
- return True
-
- DiscoveryIP ipaddr port
- | DatagramAddress saddr <- peerAddress peer
- , Just paddr <- inetFromSockAddr saddr
- -> do
- return $ ( ipaddr, port ) == paddr
- _ -> return False
+ let matchedAddrs = flip filter addrs $ \case
+ DiscoveryICE -> True
+ DiscoveryIP ipaddr port ->
+ DatagramAddress (inetToSockAddr ( ipaddr, port )) `elem` paddrs
+ _ -> False
forM_ (idDataF =<< unfoldOwners pid) $ \sdata -> do
let dp = DiscoveryPeer
diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
index 76ecd82..63ce7b8 100644
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -8,7 +8,7 @@ module Erebos.Network (
ServerOptions(..), serverIdentity, defaultServerOptions,
Peer, peerServer, peerStorage,
- PeerAddress(..), peerAddress,
+ PeerAddress(..), getPeerAddress, getPeerAddresses,
PeerIdentity(..), peerIdentity,
WaitingRef, wrDigest,
Service(..),
@@ -139,6 +139,14 @@ data Peer = Peer
, peerWaitingRefs :: TMVar [WaitingRef]
}
+-- | Get current main address of the peer (used to send new packets).
+getPeerAddress :: MonadIO m => Peer -> m PeerAddress
+getPeerAddress = liftIO . return . peerAddress
+
+-- | Get all known addresses of given peer.
+getPeerAddresses :: MonadIO m => Peer -> m [ PeerAddress ]
+getPeerAddresses = fmap (: []) . getPeerAddress
+
peerServer :: Peer -> Server
peerServer = peerServer_