From fb074d4decf6a1406ad39737741a061e1b5bc2d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sat, 1 Jun 2024 20:36:54 +0200 Subject: Drop peer on packet delivery failure --- src/Erebos/Network.hs | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) (limited to 'src/Erebos/Network.hs') diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs index f234971..41b6279 100644 --- a/src/Erebos/Network.hs +++ b/src/Erebos/Network.hs @@ -342,12 +342,17 @@ startServer opt serverOrigHead logd' serverServices = do _ -> return () Nothing -> return () - forever $ do - (secure, TransportPacket header objs) <- readFlowIO $ connData conn - prefs <- forM objs $ storeObject $ peerInStorage peer - identity <- readMVar serverIdentity_ - let svcs = map someServiceID serverServices - handlePacket identity secure peer chanSvc svcs header prefs + let peerLoop = readFlowIO (connData conn) >>= \case + Just (secure, TransportPacket header objs) -> do + prefs <- forM objs $ storeObject $ peerInStorage peer + identity <- readMVar serverIdentity_ + let svcs = map someServiceID serverServices + handlePacket identity secure peer chanSvc svcs header prefs + peerLoop + Nothing -> do + dropPeer peer + atomically $ writeTChan serverChanPeer peer + peerLoop ReceivedAnnounce addr _ -> do void $ serverPeer' server addr -- cgit v1.2.3