diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2024-06-01 20:36:54 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-06-01 21:07:01 +0200 |
| commit | fb074d4decf6a1406ad39737741a061e1b5bc2d1 (patch) | |
| tree | 729c04bfb3eacecb770a18a0fdbe3d3ecd027cd7 /src/Erebos/Network.hs | |
| parent | d0f1ce6171ccb59fce7534a19e827352b35686a0 (diff) | |
Drop peer on packet delivery failure
Diffstat (limited to 'src/Erebos/Network.hs')
| -rw-r--r-- | src/Erebos/Network.hs | 17 |
1 files changed, 11 insertions, 6 deletions
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 |