From c0eade91d39d27e62e7586e75efb3616b4ba18af Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Wed, 9 Jul 2025 18:54:20 +0200
Subject: Network: findPeer function

---
 src/Erebos/Network.hs | 8 ++++++++
 1 file changed, 8 insertions(+)

(limited to 'src/Erebos')

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
-- 
cgit v1.2.3