Network: findPeer function

1 files changed, 8 insertions, 0 deletions

diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
index 8da4c8d..aff04e4 100644
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -23,6 +23,7 @@ module Erebos.Network (
 #ifdef ENABLE_ICE_SUPPORT
     serverPeerIce,
 #endif
+    findPeer,
     dropPeer,
     isPeerDropped,
     sendToPeer, sendManyToPeer,
@@ -879,6 +880,13 @@ serverPeer' server paddr = do
         writeFlow (serverControlFlow server) (RequestConnection paddr)
     return peer
 
+findPeer :: Server -> (Peer -> IO Bool) -> IO (Maybe Peer)
+findPeer server test = withMVar (serverPeers server) (helper . M.elems)
+  where
+    helper (p : ps) = test p >>= \case True  -> return (Just p)
+                                       False -> helper ps
+    helper []       = return Nothing
+
 dropPeer :: MonadIO m => Peer -> m ()
 dropPeer peer = liftIO $ do
     modifyMVar_ (serverPeers $ peerServer peer) $ \pvalue -> do