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 --- main/Main.hs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) (limited to 'main/Main.hs') diff --git a/main/Main.hs b/main/Main.hs index 44e2f7b..df904a2 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -236,17 +236,21 @@ interactiveLoop st opts = runInputT inputSettings $ do peer <- getNextPeerChange server peerIdentity peer >>= \case pid@(PeerIdentityFull _) -> do + dropped <- isPeerDropped peer let shown = showPeer pid $ peerAddress peer - let update [] = ([(peer, shown)], Nothing) - update ((p,s):ps) | p == peer = ((peer, shown) : ps, Just s) - | otherwise = first ((p,s):) $ update ps + let update [] = ([(peer, shown)], (Nothing, "NEW")) + update ((p,s):ps) + | p == peer && dropped = (ps, (Nothing, "DEL")) + | p == peer = ((peer, shown) : ps, (Just s, "UPD")) + | otherwise = first ((p,s):) $ update ps let ctxUpdate n [] = ([SelectedPeer peer], n) ctxUpdate n (ctx:ctxs) | SelectedPeer p <- ctx, p == peer = (ctx:ctxs, n) | otherwise = first (ctx:) $ ctxUpdate (n + 1) ctxs - op <- modifyMVar peers (return . update) + (op, updateType) <- modifyMVar peers (return . update) + let updateType' = if dropped then "DEL" else updateType idx <- modifyMVar contextOptions (return . ctxUpdate (1 :: Int)) - when (Just shown /= op) $ extPrint $ "[" <> show idx <> "] PEER " <> shown + when (Just shown /= op) $ extPrint $ "[" <> show idx <> "] PEER " <> updateType' <> " " <> shown _ -> return () let getInputLines prompt = do -- cgit v1.2.3